mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-14 11:39:35 +02:00
840 lines
23 KiB
PHP
840 lines
23 KiB
PHP
{%MainUnit ../comctrls.pp}
|
|
{ $Id$
|
|
|
|
*****************************************************************************
|
|
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.
|
|
*****************************************************************************
|
|
}
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems Constructor }
|
|
{------------------------------------------------------------------------------}
|
|
constructor TListItems.Create(AOwner : TCustomListView);
|
|
begin
|
|
Inherited Create;
|
|
FItems := TFPList.Create;
|
|
FOwner := AOwner;
|
|
FCacheIndex := -1;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems GetCount }
|
|
{------------------------------------------------------------------------------}
|
|
function TListItems.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
procedure TListItems.SetCount(const ACount: Integer);
|
|
begin
|
|
//just ignore!
|
|
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;
|
|
end;
|
|
end;
|
|
|
|
function TListItems.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems SetItem }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.SetItem(const AIndex: Integer; const AValue: TListItem);
|
|
var
|
|
OldItem: TListItem;
|
|
begin
|
|
if Count - 1 < AIndex then Exit;
|
|
|
|
OldItem := GetItem(AIndex);
|
|
if OldItem = AValue then Exit;
|
|
|
|
FItems.Items[AIndex] := AValue;
|
|
FCacheIndex := AIndex;
|
|
FCacheItem := AValue;
|
|
|
|
if WSUpdateAllowed then
|
|
WSUpdateItem(AIndex, AValue);
|
|
|
|
if AValue.WSUpdateAllowed
|
|
then begin
|
|
AValue.WSUpdateText;
|
|
AValue.WSUpdateImages;
|
|
AValue.WSUpdateChecked;
|
|
AValue.WSUpdateState;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems Add }
|
|
{------------------------------------------------------------------------------}
|
|
function TListItems.Add: TListItem;
|
|
begin
|
|
if Assigned(Owner) then
|
|
Result := Owner.CreateListItem
|
|
else
|
|
Result := TListItem.Create(Self);
|
|
AddItem(Result);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems AddItem }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.AddItem(AItem: TListItem);
|
|
begin
|
|
FCacheIndex := FItems.Add(AItem);
|
|
FCacheItem := AItem;
|
|
|
|
if WSUpdateAllowed
|
|
then WSCreateCacheItem;
|
|
|
|
//Notify parent TListView that something was added.
|
|
if FOwner <> nil
|
|
then FOwner.ItemInserted(AItem);
|
|
end;
|
|
|
|
procedure TListItems.BeginUpdate;
|
|
begin
|
|
Owner.BeginUpdate;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
TListItems Clear
|
|
------------------------------------------------------------------------------}
|
|
procedure TListItems.Clear;
|
|
begin
|
|
while Count > 0 do Delete(Count-1)
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems Delete }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.Delete(const AIndex: Integer);
|
|
begin
|
|
// Don't use GetItem, it updates the cache, which then will become invalid
|
|
TListItem(FItems.Items[AIndex]).Delete;
|
|
end;
|
|
|
|
procedure TListItems.EndUpdate;
|
|
begin
|
|
Owner.EndUpdate;
|
|
end;
|
|
|
|
procedure TListItems.Exchange(const AIndex1, AIndex2: Integer);
|
|
var
|
|
AItem: TListItem;
|
|
SelItem: TListItem;
|
|
FocusItem: TListItem;
|
|
begin
|
|
if AIndex1 = AIndex2 then
|
|
exit;
|
|
if (AIndex1 < 0) or (AIndex1 >= FItems.Count) then
|
|
raise Exception.CreateFmt(rsListIndexExceedsBounds, [AIndex1]);
|
|
if (AIndex2 < 0) or (AIndex2 >= FItems.Count) then
|
|
raise Exception.CreateFmt(rsListIndexExceedsBounds, [AIndex2]);
|
|
AItem := Item[AIndex1];
|
|
SelItem := Owner.Selected;
|
|
FocusItem := Owner.ItemFocused;
|
|
|
|
Include(Owner.FFlags, lffItemsMoving);
|
|
try
|
|
FItems.Exchange(AIndex1, AIndex2);
|
|
FCacheIndex := AIndex1;
|
|
FCacheItem := AItem;
|
|
if not Owner.OwnerData and WSUpdateAllowed then
|
|
begin
|
|
TWSCustomListViewClass(FOwner.WidgetSetClass).ItemExchange(FOwner, AItem,
|
|
AIndex1, AIndex2);
|
|
Owner.InvalidateSelected;
|
|
Owner.ItemFocused := nil;
|
|
Owner.Selected := SelItem;
|
|
Owner.ItemFocused := FocusItem;
|
|
end;
|
|
finally
|
|
Exclude(Owner.FFlags, lffItemsMoving);
|
|
end;
|
|
end;
|
|
|
|
procedure TListItems.Move(const AFromIndex, AToIndex: Integer);
|
|
var
|
|
AItem: TListItem;
|
|
SelItem: TListItem;
|
|
FocusItem: TListItem;
|
|
begin
|
|
if AFromIndex = AToIndex then
|
|
exit;
|
|
if (AFromIndex < 0) or (AFromIndex >= FItems.Count) then
|
|
raise Exception.CreateFmt(rsListIndexExceedsBounds, [AFromIndex]);
|
|
if (AToIndex < 0) or (AToIndex >= FItems.Count) then
|
|
raise Exception.CreateFmt(rsListIndexExceedsBounds, [AToIndex]);
|
|
AItem := Item[AFromIndex];
|
|
SelItem := Owner.Selected;
|
|
FocusItem := Owner.ItemFocused;
|
|
Include(Owner.FFlags, lffItemsMoving);
|
|
try
|
|
FItems.Move(AFromIndex, AToIndex);
|
|
FCacheIndex := AToIndex;
|
|
FCacheItem := AItem;
|
|
if not Owner.OwnerData and WSUpdateAllowed then
|
|
begin
|
|
TWSCustomListViewClass(FOwner.WidgetSetClass).ItemMove(FOwner, AItem,
|
|
AFromIndex, AToIndex);
|
|
Owner.InvalidateSelected;
|
|
Owner.ItemFocused := nil;
|
|
Owner.Selected := SelItem;
|
|
Owner.ItemFocused := FocusItem;
|
|
end;
|
|
finally
|
|
Exclude(Owner.FFlags, lffItemsMoving);
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems IntfCreateItem }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.WSCreateCacheItem;
|
|
begin
|
|
TWSCustomListViewClass(FOwner.WidgetSetClass).ItemInsert(FOwner, FCacheIndex, FCacheItem);
|
|
Include(FCacheItem.FFlags, lifCreated);
|
|
FCacheItem.WSUpdateText;
|
|
FCacheItem.WSUpdateImages;
|
|
FCacheItem.WSUpdateChecked;
|
|
if not (lisfWSItemsCreated in FFlags) then
|
|
FCacheItem.WSSetState;
|
|
FCacheItem.WSUpdateState;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems IntfCreateItems }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.WSCreateItems;
|
|
var
|
|
n: integer;
|
|
begin
|
|
for n := 0 to FItems.Count - 1 do
|
|
begin
|
|
FCacheItem := TListItem(FItems[n]);
|
|
FCacheIndex := n;
|
|
WSCreateCacheItem;
|
|
end;
|
|
Include(FFlags, lisfWSItemsCreated);
|
|
end;
|
|
|
|
procedure TListItems.DoFinalizeWnd;
|
|
begin
|
|
Exclude(FFlags, lisfWSItemsCreated);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems IntfUpdateAllowed }
|
|
{------------------------------------------------------------------------------}
|
|
function TListItems.WSUpdateAllowed: Boolean;
|
|
begin
|
|
Result := (FOwner <> nil)
|
|
and FOwner.HandleAllocated
|
|
and not (csDestroying in FOwner.ComponentState);
|
|
end;
|
|
|
|
procedure TListItems.WSUpdateItem(const AIndex: Integer; const AValue: TListItem);
|
|
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 }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.ItemDestroying(const AItem: TListItem);
|
|
var
|
|
idx: Integer;
|
|
begin
|
|
// Don't use IndexOf, it updates the cache, which then will become invalid
|
|
//DebugLn('TListItems.ItemDestroying ',dbgs(AItem));
|
|
if (FCacheIndex <> -1) and (FCacheItem = AItem) then
|
|
idx := FCacheIndex
|
|
else
|
|
idx := FItems.IndexOf(AItem);
|
|
|
|
if idx = -1 then Exit; //?????
|
|
|
|
if FOwner <> nil then
|
|
begin
|
|
|
|
FOwner.ItemDeleted(AItem);
|
|
|
|
// trigger DoSelectItem before deletion - Delphi compat. issue #21335
|
|
// but fire after ItemIndex is invalidated. issue #21346
|
|
if FOwner.HandleAllocated and AItem.Selected and
|
|
not (csDestroying in FOwner.Componentstate) then
|
|
FOwner.DoSelectItem(AItem, False);
|
|
|
|
if (FOwner.HandleAllocated) and (lifCreated in AItem.FFlags) then
|
|
begin
|
|
Exclude(AItem.FFlags, lifCreated);
|
|
TWSCustomListViewClass(FOwner.WidgetSetClass).ItemDelete(FOwner, idx);
|
|
end;
|
|
end;
|
|
|
|
if FCacheIndex >= idx then
|
|
FCacheIndex := -1;
|
|
FItems.Delete(idx);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
TListItems IndexOf
|
|
------------------------------------------------------------------------------}
|
|
function TListItems.IndexOf(const AItem: TListItem): Integer;
|
|
begin
|
|
if (FCacheIndex <> -1)
|
|
and (FCacheItem = AItem)
|
|
then begin
|
|
Result := FCacheIndex;
|
|
Exit;
|
|
end;
|
|
|
|
Result := FItems.IndexOf(AItem);
|
|
if Result = -1 then Exit;
|
|
|
|
FCacheIndex := Result;
|
|
FCacheItem := AItem;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
TListItems Insert
|
|
------------------------------------------------------------------------------}
|
|
function TListItems.Insert(const AIndex: Integer): TListItem;
|
|
begin
|
|
if Assigned(Owner) then
|
|
Result := Owner.CreateListItem
|
|
else
|
|
Result := TListItem.Create(Self);
|
|
InsertItem(Result, AIndex);
|
|
end;
|
|
|
|
procedure TListItems.SelectAll;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
if not (lisSelected in Item[i].FStates) then
|
|
begin
|
|
Self.Item[i].FStates := Self.Item[i].FStates + [lisSelected];
|
|
if Assigned(Owner.OnSelectItem) then
|
|
Owner.OnSelectItem(Owner, Item[i], True);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TListItems.ClearSelection;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
begin
|
|
if (lisSelected in Item[i].FStates) then
|
|
begin
|
|
Self.Item[i].FStates := Self.Item[i].FStates - [lisSelected];
|
|
if Assigned(Owner.OnSelectItem) then
|
|
Owner.OnSelectItem(Owner, Item[i], False);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
TListItems InsertItem
|
|
------------------------------------------------------------------------------}
|
|
procedure TListItems.InsertItem(AItem: TListItem; const AIndex: Integer);
|
|
begin
|
|
FItems.Insert(AIndex, AItem);
|
|
FCacheIndex := AIndex;
|
|
FCacheItem := AItem;
|
|
|
|
if WSUpdateAllowed
|
|
then WSCreateCacheItem;
|
|
|
|
//Notify parent TListView that something was added.
|
|
if FOwner <> nil
|
|
then FOwner.ItemInserted(AItem);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems Destructor }
|
|
{------------------------------------------------------------------------------}
|
|
destructor TListItems.Destroy;
|
|
begin
|
|
if not FOwner.FOwnerData then
|
|
begin
|
|
// 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);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems FindCaption }
|
|
{------------------------------------------------------------------------------}
|
|
function TListItems.FindCaption(StartIndex: Integer; Value: string;
|
|
Partial, Inclusive, Wrap: Boolean; PartStart: Boolean): TListItem;
|
|
var
|
|
I: Integer;
|
|
CaptionFound, AllChecked: Boolean;
|
|
begin
|
|
result := nil;
|
|
if (Count = 0) or (StartIndex >= Count) or (not Inclusive and (count = 1)) then Exit;
|
|
CaptionFound := False;
|
|
AllChecked := False;
|
|
if Inclusive then
|
|
I := StartIndex
|
|
else begin
|
|
I := succ(StartIndex);
|
|
if I >= Count then I := 0;
|
|
end;
|
|
if Wrap then Wrap := (StartIndex <> 0);
|
|
repeat
|
|
if Partial then begin
|
|
if PartStart then
|
|
CaptionFound := pos(Value, Item[I].Caption) = 1
|
|
else
|
|
CaptionFound := pos(Value, Item[I].Caption) <> 0;
|
|
end else
|
|
CaptionFound := Value = Item[I].Caption;
|
|
if not CaptionFound then begin
|
|
Inc(I);
|
|
if Wrap then begin
|
|
if I = Count then
|
|
I := 0
|
|
else
|
|
if I = StartIndex then
|
|
AllChecked := True;
|
|
end else begin
|
|
if I = Count then AllChecked := True;
|
|
end;
|
|
end;
|
|
until CaptionFound or AllChecked;
|
|
if CaptionFound then result := Item[I];
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems FindData }
|
|
{------------------------------------------------------------------------------}
|
|
function TListItems.FindData(const AData: Pointer): TListItem;
|
|
var
|
|
n: Integer;
|
|
begin
|
|
if (FCacheIndex <> -1)
|
|
and (FCacheItem <> nil)
|
|
and (FCacheItem.Data = AData)
|
|
then begin
|
|
Result := FCacheItem;
|
|
Exit;
|
|
end;
|
|
|
|
for n := 0 to FItems.Count - 1 do
|
|
begin
|
|
Result := TListItem(FItems[n]);
|
|
if Result.Data = AData
|
|
then begin
|
|
FCacheIndex := n;
|
|
FCacheItem := Result;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TListItems.FindData(StartIndex: Integer; Value: Pointer; Inclusive,
|
|
Wrap: Boolean): TListItem;
|
|
var
|
|
AnItem: TListItem;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
if Inclusive then Dec(StartIndex);
|
|
for i := StartIndex + 1 to Count - 1 do
|
|
begin
|
|
AnItem := Item[i];
|
|
if (AnItem <> nil) and (AnItem.Data = Value) then
|
|
begin
|
|
Result := AnItem;
|
|
exit;
|
|
end;
|
|
end;
|
|
if Wrap then
|
|
begin
|
|
if Inclusive then Inc(StartIndex);
|
|
for i := 0 to StartIndex - 1 do
|
|
begin
|
|
AnItem := Item[i];
|
|
if (AnItem <> nil) and (AnItem.Data = Value) then
|
|
begin
|
|
Result := AnItem;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TListItems.GetEnumerator: TListItemsEnumerator;
|
|
begin
|
|
Result := TListItemsEnumerator.Create(Self);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ TListItems DefineProperties }
|
|
{------------------------------------------------------------------------------}
|
|
procedure TListItems.DefineProperties(Filer: TFiler);
|
|
|
|
function WriteItems: Boolean;
|
|
var
|
|
I: Integer;
|
|
Items: TListItems;
|
|
begin
|
|
Items := TListItems(Filer.Ancestor);
|
|
if not Assigned(Items) then
|
|
Result := Count > 0
|
|
else if (Items.Count <> Count) then
|
|
Result := True
|
|
else
|
|
begin
|
|
Result := False;
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
Result := not Item[I].IsEqual(Items[I]);
|
|
if Result then Break;
|
|
end
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineBinaryProperty('Data', @ReadData, nil, false);
|
|
Filer.DefineBinaryProperty('LazData', @ReadLazData, @WriteLazData, WriteItems);
|
|
end;
|
|
|
|
type
|
|
TItemHeader = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
|
Size, Count: Integer;
|
|
Items: record end;
|
|
end;
|
|
// for reading Delphi compatible TListItem.Data
|
|
TItemInfo = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
|
ImageIndex: Integer;
|
|
StateIndex: Integer;
|
|
OverlayIndex: Integer;
|
|
SubItemCount: Integer;
|
|
Data: Integer; // pointer field on 32 bits computers
|
|
end;
|
|
// Lazarus does not store ListItem.Data field, because a pointer field cannot
|
|
// be made 64 bits safe
|
|
TLazItemInfo = record // packing is not needed and not wanted
|
|
ImageIndex: Integer;
|
|
StateIndex: Integer;
|
|
OverlayIndex: Integer;
|
|
SubItemCount: Integer;
|
|
end;
|
|
|
|
procedure TListItems.ReadData(Stream: TStream);
|
|
function ReadString: String;
|
|
var
|
|
Len: Byte;
|
|
begin
|
|
Len := Stream.ReadByte;
|
|
SetLength(Result, Len);
|
|
Stream.ReadBuffer(Result[1], Len);
|
|
end;
|
|
|
|
var
|
|
I, J: Integer;
|
|
ItemInfo: TItemInfo;
|
|
ListItem: TListItem;
|
|
Size, ItemCount, SubCount: Integer;
|
|
StartPos: Int64;
|
|
begin
|
|
Clear;
|
|
StartPos := Stream.Position;
|
|
Size := LEtoN(Integer(Stream.ReadDWord));
|
|
ItemCount := LEtoN(Integer(Stream.ReadDWord));
|
|
Owner.BeginUpdate;
|
|
try
|
|
for I := 0 to ItemCount - 1 do
|
|
begin
|
|
Stream.ReadBuffer(ItemInfo, SizeOf(ItemInfo));
|
|
ListItem := Add;
|
|
ListItem.Caption := ReadString;
|
|
ListItem.ImageIndex := LEtoN(ItemInfo.ImageIndex);
|
|
// ListItem.StateIndex := LEtoN(ItemInfo.StateIndex);
|
|
// ListItem.OverlayIndex := LEtoN(ItemInfo.OverlayIndex);
|
|
|
|
//TODO: check if we need to stream a data pointer
|
|
ListItem.Data := Pointer(LEtoN(PtrInt(ItemInfo.Data)));
|
|
|
|
SubCount := LEtoN(ItemInfo.SubItemCount);
|
|
for J := 0 to SubCount - 1 do
|
|
begin
|
|
ListItem.SubItems.Add(ReadString);
|
|
end;
|
|
end;
|
|
|
|
//read subitem images
|
|
if Stream.Position < StartPos + Size
|
|
then begin
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
ListItem := Item[I];
|
|
if ListItem.FSubItems = nil then Continue;
|
|
|
|
for J := 0 to ListItem.SubItems.Count - 1 do
|
|
ListItem.SubItemImages[J] := LEtoN(Integer(Stream.ReadDWord));
|
|
end;
|
|
end;
|
|
finally
|
|
Owner.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TListItems.ReadLazData(Stream: TStream);
|
|
var
|
|
I, J: Integer;
|
|
ItemInfo: TLazItemInfo;
|
|
ListItem: TListItem;
|
|
Size, ItemCount, SubCount: Integer;
|
|
StartPos: Int64;
|
|
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
|
|
{ This is a local redefinition of TStream.ReadAnsiString(), which ensures
|
|
that the string length is read in little-endian order to conform to the
|
|
convention of the remaining resources.
|
|
}
|
|
function stream_readAnsiStringLE(): AnsiString;
|
|
|
|
Var
|
|
TheSize : Longint;
|
|
P : PByte ;
|
|
begin
|
|
Stream.ReadBuffer (TheSize,SizeOf(TheSize));
|
|
TheSize := LEtoN(TheSize);
|
|
SetLength(Result,TheSize);
|
|
// Illegal typecast if no AnsiStrings defined.
|
|
if TheSize>0 then
|
|
begin
|
|
Stream.ReadBuffer (Pointer(Result)^,TheSize);
|
|
P:=Pointer(Result)+TheSize;
|
|
p^:=0;
|
|
end
|
|
end { stream_readAnsiStringLE } ;
|
|
|
|
{$endif FPC_BIG_ENDIAN}
|
|
|
|
begin
|
|
Clear;
|
|
StartPos := Stream.Position;
|
|
Size := LEtoN(Integer(Stream.ReadDWord));
|
|
ItemCount := LEtoN(Integer(Stream.ReadDWord));
|
|
Owner.BeginUpdate;
|
|
try
|
|
for I := 0 to ItemCount - 1 do
|
|
begin
|
|
Stream.ReadBuffer(ItemInfo, SizeOf(ItemInfo));
|
|
ListItem := Add;
|
|
{$ifndef FPC_BIG_ENDIAN}
|
|
ListItem.Caption := Stream.ReadAnsiString();
|
|
{$else}
|
|
ListItem.Caption := stream_readAnsiStringLE;
|
|
{$endif FPC_BIG_ENDIAN}
|
|
ListItem.ImageIndex := LEtoN(ItemInfo.ImageIndex);
|
|
// ListItem.StateIndex := LEtoN(ItemInfo.StateIndex);
|
|
// ListItem.OverlayIndex := LEtoN(ItemInfo.OverlayIndex);
|
|
|
|
SubCount := LEtoN(ItemInfo.SubItemCount);
|
|
for J := 0 to SubCount - 1 do
|
|
begin
|
|
{$ifndef FPC_BIG_ENDIAN}
|
|
ListItem.SubItems.Add(Stream.ReadAnsiString);
|
|
{$else}
|
|
ListItem.SubItems.Add(stream_readAnsiStringLE())
|
|
{$endif FPC_BIG_ENDIAN}
|
|
end;
|
|
end;
|
|
|
|
//read subitem images
|
|
if Stream.Position < StartPos + Size
|
|
then begin
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
ListItem := Item[I];
|
|
if ListItem.FSubItems = nil then Continue;
|
|
|
|
for J := 0 to ListItem.SubItems.Count - 1 do
|
|
ListItem.SubItemImages[J] := LEtoN(Integer(Stream.ReadDWord));
|
|
end;
|
|
end;
|
|
finally
|
|
Owner.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TListItems.WriteLazData(Stream: TStream);
|
|
var
|
|
I, J, Size, L : Integer;
|
|
ItemHeader : TItemHeader;
|
|
ItemInfo : TLazItemInfo;
|
|
ListItem : TListItem;
|
|
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
|
|
{ This is a local redefinition of TStream.WriteAnsiString(), which ensures
|
|
that the string length is written in little-endian order to conform to the
|
|
convention of the remaining resources.
|
|
}
|
|
procedure stream_writeAnsiStringLE(const S: AnsiString);
|
|
|
|
Var L : Longint;
|
|
|
|
begin
|
|
L:=NtoLE(Length(S));
|
|
Stream.WriteBuffer (L,SizeOf(L));
|
|
Stream.WriteBuffer (Pointer(S)^,L)
|
|
end { stream_writeAnsiStringLE } ;
|
|
|
|
{$endif FPC_BIG_ENDIAN}
|
|
|
|
begin
|
|
Size := SizeOf(ItemHeader);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
L := Length(Item[I].Caption) + 4;
|
|
for J := 0 to Item[I].SubItems.Count - 1 do
|
|
begin
|
|
Inc(L, Length(Item[I].SubItems[J]) + 4);
|
|
Inc(L, SizeOf(DWORD));
|
|
end;
|
|
Inc(Size, SizeOf(TLazItemInfo) + L);
|
|
end;
|
|
|
|
ItemHeader.Size := NtoLE(Size);
|
|
ItemHeader.Count := NtoLE(Count);
|
|
Stream.WriteBuffer(ItemHeader, SizeOf(ItemHeader));
|
|
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
ListItem := Item[I];
|
|
|
|
ItemInfo.ImageIndex := NtoLE(ListItem.ImageIndex);
|
|
ItemInfo.StateIndex := NtoLE(Integer(-1)) {StateIndex};
|
|
ItemInfo.OverlayIndex := NtoLE(Integer(-1)) {OverlayIndex};
|
|
// don't acces SubItems directly, they will be created
|
|
if ListItem.FSubItems = nil
|
|
then ItemInfo.SubItemCount := 0
|
|
else ItemInfo.SubItemCount := NtoLE(ListItem.SubItems.Count);
|
|
|
|
Stream.WriteBuffer(ItemInfo, SizeOf(ItemInfo));
|
|
|
|
// Write the strings
|
|
{$ifndef FPC_BIG_ENDIAN}
|
|
Stream.WriteAnsiString(ListItem.Caption);
|
|
{$else}
|
|
stream_writeAnsiStringLE(ListItem.Caption);
|
|
{$endif FPC_BIG_ENDIAN}
|
|
|
|
for J := 0 to ItemInfo.SubItemCount - 1 do
|
|
begin
|
|
{$ifndef FPC_BIG_ENDIAN}
|
|
Stream.WriteAnsiString(ListItem.SubItems[J]);
|
|
{$else}
|
|
stream_writeAnsiStringLE(ListItem.SubItems[J])
|
|
{$endif FPC_BIG_ENDIAN}
|
|
end;
|
|
end;
|
|
|
|
//write SubItem images.
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
ListItem := Item[I];
|
|
// do not force subitem creation
|
|
if ListItem.FSubItems = nil then Continue;
|
|
for J := 0 to ListItem.SubItems.Count - 1 do
|
|
begin
|
|
Stream.WriteDWord(DWord(ListItem.SubItemImages[J]));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TOwnerDataListItems }
|
|
|
|
function TOwnerDataListItems.GetCount: Integer;
|
|
begin
|
|
Result:=fItemsCount;
|
|
end;
|
|
|
|
procedure TOwnerDataListItems.SetCount(const ACount: Integer);
|
|
begin
|
|
if (ACount<0) or (ACount=fItemsCount) then Exit;
|
|
fItemsCount:=ACount;
|
|
if WSUpdateAllowed then WSSetItemsCount(fItemsCount);
|
|
// reset ownerdata
|
|
if (FOwner.FOwnerDataItem.Index >= fItemsCount) then
|
|
FOwner.FOwnerDataItem.SetDataIndex(-1);
|
|
// invalidate selection
|
|
FOwner.InvalidateSelected;
|
|
end;
|
|
|
|
function TOwnerDataListItems.GetItem(const AIndex: Integer): TListItem;
|
|
begin
|
|
if (AIndex >= FItemsCount) then
|
|
begin
|
|
Result := nil;
|
|
Exit;
|
|
end;
|
|
FOwner.FOwnerDataItem.SetDataIndex(AIndex);
|
|
Result := FOwner.FOwnerDataItem;
|
|
end;
|
|
|
|
procedure TOwnerDataListItems.Clear;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
for i := 0 to FItems.Count - 1 do
|
|
begin
|
|
TListItem(FItems[i]).Free;
|
|
FItems[i]:=nil;
|
|
end;
|
|
Count := 0;
|
|
fItemsCount := 0;
|
|
end;
|
|
|