mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-18 07:59:28 +02:00
LCL: fixed loading ListView items on 64 bits targets
+ the LCL now reads/writes ListView.Items.LazData property which does not include ListItem.Data pointer value * the only reads, but doesn't write ListView.Items.Data property. It assumes a 32 bit data field. This is to be compatible with existing lfm files and Delphi. git-svn-id: trunk@10946 -
This commit is contained in:
parent
f37189d56d
commit
263aa5147d
@ -673,8 +673,9 @@ type
|
|||||||
procedure WSCreateCacheItem;
|
procedure WSCreateCacheItem;
|
||||||
function WSUpdateAllowed: Boolean;
|
function WSUpdateAllowed: Boolean;
|
||||||
procedure ItemDestroying(const AItem: TListItem); //called by TListItem when freed
|
procedure ItemDestroying(const AItem: TListItem); //called by TListItem when freed
|
||||||
procedure ReadData(Stream: TStream);
|
procedure ReadData(Stream: TStream); // read data in a Delphi compatible way
|
||||||
procedure WriteData(Stream: TStream);
|
procedure ReadLazData(Stream: TStream); // read data in a 64 bits safe way
|
||||||
|
procedure WriteLazData(Stream: TStream); // write date in a 64 bits safe way
|
||||||
protected
|
protected
|
||||||
procedure DefineProperties(Filer: TFiler); override;
|
procedure DefineProperties(Filer: TFiler); override;
|
||||||
function GetCount : Integer;
|
function GetCount : Integer;
|
||||||
|
@ -351,26 +351,31 @@ procedure TListItems.DefineProperties(Filer: TFiler);
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
inherited DefineProperties(Filer);
|
inherited DefineProperties(Filer);
|
||||||
Filer.DefineBinaryProperty('Data', @ReadData, @WriteData, WriteItems);
|
Filer.DefineBinaryProperty('Data', @ReadData, nil, false);
|
||||||
|
Filer.DefineBinaryProperty('LazData', @ReadLazData, @WriteLazData, WriteItems);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
type
|
type
|
||||||
PItemHeader = ^TItemHeader;
|
|
||||||
TItemHeader = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
TItemHeader = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
||||||
Size, Count: Integer;
|
Size, Count: Integer;
|
||||||
Items: record end;
|
Items: record end;
|
||||||
end;
|
end;
|
||||||
PItemInfo = ^TItemInfo;
|
// for reading Delphi compatible TListItem.Data
|
||||||
TItemInfo = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
TItemInfo = record // packing is not needed (and not wanted since it controls also how this record is stored)
|
||||||
ImageIndex: Integer;
|
ImageIndex: Integer;
|
||||||
StateIndex: Integer;
|
StateIndex: Integer;
|
||||||
OverlayIndex: Integer;
|
OverlayIndex: Integer;
|
||||||
SubItemCount: Integer;
|
SubItemCount: Integer;
|
||||||
Data: Pointer;
|
Data: Integer; // pointer field on 32 bits computers
|
||||||
//Caption: string[255]; // all stings follow here
|
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;
|
end;
|
||||||
ShortStr = string[255];
|
|
||||||
PShortStr = ^ShortStr;
|
|
||||||
|
|
||||||
procedure TListItems.ReadData(Stream: TStream);
|
procedure TListItems.ReadData(Stream: TStream);
|
||||||
function ReadString: String;
|
function ReadString: String;
|
||||||
@ -391,7 +396,7 @@ var
|
|||||||
begin
|
begin
|
||||||
Clear;
|
Clear;
|
||||||
StartPos := Stream.Position;
|
StartPos := Stream.Position;
|
||||||
Size := Stream.ReadDWord;
|
Size := LEtoN(Integer(Stream.ReadDWord));
|
||||||
ItemCount := LEtoN(Integer(Stream.ReadDWord));
|
ItemCount := LEtoN(Integer(Stream.ReadDWord));
|
||||||
Owner.BeginUpdate;
|
Owner.BeginUpdate;
|
||||||
try
|
try
|
||||||
@ -431,40 +436,71 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TListItems.WriteData(Stream: TStream);
|
procedure TListItems.ReadLazData(Stream: TStream);
|
||||||
function GetLength(const S: string): Integer;
|
var
|
||||||
|
I, J: Integer;
|
||||||
|
ItemInfo: TLazItemInfo;
|
||||||
|
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
|
begin
|
||||||
Result := Length(S);
|
Stream.ReadBuffer(ItemInfo, SizeOf(ItemInfo));
|
||||||
if Result > 255 then Result := 255;
|
ListItem := Add;
|
||||||
|
ListItem.Caption := Stream.ReadAnsiString;
|
||||||
|
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
|
||||||
|
ListItem.SubItems.Add(Stream.ReadAnsiString);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure WriteString(const S: String);
|
//read subitem images
|
||||||
var
|
if Stream.Position < StartPos + Size
|
||||||
Len: Integer;
|
then begin
|
||||||
|
for I := 0 to Count - 1 do
|
||||||
begin
|
begin
|
||||||
Len := Length(S);
|
ListItem := Item[I];
|
||||||
if Len > 255 then Len := 255;
|
if ListItem.FSubItems = nil then Continue;
|
||||||
Stream.WriteByte(Len);
|
|
||||||
Stream.WriteBuffer(S[1], Len);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
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
|
var
|
||||||
I, J, Size, L : Integer;
|
I, J, Size, L : Integer;
|
||||||
ItemHeader : TItemHeader;
|
ItemHeader : TItemHeader;
|
||||||
ItemInfo : TItemInfo;
|
ItemInfo : TLazItemInfo;
|
||||||
ListItem : TListItem;
|
ListItem : TListItem;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Size := SizeOf(ItemHeader);
|
Size := SizeOf(ItemHeader);
|
||||||
for I := 0 to Count - 1 do
|
for I := 0 to Count - 1 do
|
||||||
begin
|
begin
|
||||||
L := GetLength(Item[I].Caption) + 1;
|
L := Length(Item[I].Caption) + 4;
|
||||||
for J := 0 to Item[I].SubItems.Count - 1 do
|
for J := 0 to Item[I].SubItems.Count - 1 do
|
||||||
begin
|
begin
|
||||||
Inc(L, GetLength(Item[I].SubItems[J]) + 1);
|
Inc(L, Length(Item[I].SubItems[J]) + 4);
|
||||||
Inc(L, SizeOf(Integer));
|
Inc(L, SizeOf(DWORD));
|
||||||
end;
|
end;
|
||||||
Inc(Size, SizeOf(TItemInfo) - 255 + L);
|
Inc(Size, SizeOf(TLazItemInfo) + L);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
ItemHeader.Size := NtoLE(Size);
|
ItemHeader.Size := NtoLE(Size);
|
||||||
@ -482,17 +518,15 @@ begin
|
|||||||
if ListItem.FSubItems = nil
|
if ListItem.FSubItems = nil
|
||||||
then ItemInfo.SubItemCount := 0
|
then ItemInfo.SubItemCount := 0
|
||||||
else ItemInfo.SubItemCount := NtoLE(ListItem.SubItems.Count);
|
else ItemInfo.SubItemCount := NtoLE(ListItem.SubItems.Count);
|
||||||
// TODO: check this
|
|
||||||
// Stream pointers ???
|
|
||||||
ItemInfo.Data := Pointer(NtoLE(PtrInt(ListItem.Data)));
|
|
||||||
Stream.WriteBuffer(ItemInfo, SizeOf(ItemInfo));
|
Stream.WriteBuffer(ItemInfo, SizeOf(ItemInfo));
|
||||||
|
|
||||||
// Write the strings
|
// Write the strings
|
||||||
WriteString(ListItem.Caption);
|
Stream.WriteAnsiString(ListItem.Caption);
|
||||||
|
|
||||||
for J := 0 to ItemInfo.SubItemCount - 1 do
|
for J := 0 to ItemInfo.SubItemCount - 1 do
|
||||||
begin
|
begin
|
||||||
WriteString(ListItem.SubItems[J]);
|
Stream.WriteAnsiString(ListItem.SubItems[J]);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user