カスタム イメージ リストが DFM ファイル内のコンテンツを読み書きするパッケージを作成しています。
私が書いたコードは、XE7 から 10.3 Rio までのすべてのコンパイラでグローバルにうまく機能します。ただし、XE2 には奇妙な問題があります。この特定のコンパイラを使用すると、DFM の読み取り中に空のストリーム コンテンツを受け取ることがあり、コンテンツが破損することもあります。
私のカスタム イメージ リストは、標準の TImageList の上に構築されています。この方法で読み取りコールバックを登録します。
procedure TMyImageList.DefineProperties(pFiler: TFiler);
function DoWritePictures: Boolean;
begin
if (Assigned(pFiler.Ancestor)) then
Result := not (pFiler.Ancestor is TMyImageList)
else
Result := Count > 0;
end;
begin
inherited DefineProperties(pFiler);
// register the properties that will load and save the pictures binary data in DFM files
pFiler.DefineBinaryProperty('Pictures', ReadPictures, WritePictures, DoWritePictures);
end;
ReadPictures 関数は次のとおりです。
procedure TMyImageList.ReadPictures(pStream: TStream);
begin
LoadPictureListFromStream(m_pPictures, pStream);
end;
LoadPictureListFromStream 関数は次のとおりです。
procedure TMyImageList.LoadPictureListFromStream(pList: IWPictureList; pStream: TStream);
var
{$if CompilerVersion <= 23}
pImgNameBytes: Pointer;
pData: Pointer;
{$else}
imgNameBytes: TBytes;
{$ifend}
count, i: Integer;
color: Cardinal;
imgClassName: string;
pMemStr: TMemoryStream;
size: Int64;
pItem: IWPictureItem;
pGraphicClass: TGraphicClass;
pGraphic: TGraphic;
begin
// read the list count
pStream.ReadBuffer(count, SizeOf(count));
// is list empty?
if (count <= 0) then
Exit;
pMemStr := TMemoryStream.Create;
// enable the code below to log the received stream content
{$ifdef _DEBUG}
size := pStream.Position;
pStream.Position := 0;
pMemStr.CopyFrom(pStream, pStream.Size);
pMemStr.Position := 0;
pMemStr.SaveToFile('__DfmStreamContent.bin');
pMemStr.Clear;
pStream.Position := size;
{$endif}
try
for i := 0 to count - 1 do
begin
pItem := IWPictureItem.Create;
try
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image type from stream
if (size > 0) then
begin
{$if CompilerVersion <= 23}
pImgNameBytes := nil;
try
GetMem(pImgNameBytes, size + 1);
pStream.ReadBuffer(pImgNameBytes^, size);
pData := Pointer(NativeUInt(pImgNameBytes) + NativeUInt(size));
(PByte(pData))^ := 0;
imgClassName := UTF8ToString(pImgNameBytes);
finally
if (Assigned(pImgNameBytes)) then
FreeMem(pImgNameBytes);
end;
{$else}
SetLength(imgNameBytes, size);
pStream.Read(imgNameBytes, size);
imgClassName := TEncoding.UTF8.GetString(imgNameBytes);
{$ifend}
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the image from stream
if (size > 0) then
begin
// read the image in a temporary memory stream
pMemStr.CopyFrom(pStream, size);
pMemStr.Position := 0;
// get the graphic class to create
if (imgClassName = 'TWSVGGraphic') then
pGraphicClass := TWSVGGraphic
else
begin
TWLogHelper.LogToCompiler('Internal error - unknown graphic class - '
+ imgClassName + ' - name - ' + Name);
pGraphicClass := nil;
end;
// found it?
if (Assigned(pGraphicClass)) then
begin
pGraphic := nil;
try
// create a matching graphic to receive the image data
pGraphic := pGraphicClass.Create;
pGraphic.LoadFromStream(pMemStr);
pItem.m_pPicture.Assign(pGraphic);
finally
pGraphic.Free;
end;
end;
pMemStr.Clear;
end;
// read the next size
pStream.ReadBuffer(size, SizeOf(size));
// read the color key from stream
if (size > 0) then
begin
Assert(size = SizeOf(color));
pStream.ReadBuffer(color, size);
// get the color key
pItem.m_ColorKey := TWColor.Create((color shr 16) and $FF,
(color shr 8) and $FF,
color and $FF,
(color shr 24) and $FF);
end;
// add item to list
pList.Add(pItem);
except
pItem.Free;
raise;
end;
end;
finally
pMemStr.Free;
end;
end;
WritePictures 関数は次のとおりです。
procedure TMyImageList.WritePictures(pStream: TStream);
begin
SavePictureListToStream(m_pPictures, pStream);
end;
最後に、SavePictureListToStream 関数を次に示します。
procedure TMyImageList.SavePictureListToStream(pList: IWPictureList; pStream: TStream);
var
count, i: Integer;
color: Cardinal;
imgClassName: string;
imgNameBytes: TBytes;
pMemStr: TMemoryStream;
size: Int64;
begin
// write the list count
count := pList.Count;
pStream.WriteBuffer(count, SizeOf(count));
if (count = 0) then
Exit;
pMemStr := TMemoryStream.Create;
try
for i := 0 to count - 1 do
begin
// a picture should always be assigned in the list so this should never happen
if (not Assigned(pList[i].m_pPicture.Graphic)) then
begin
TWLogHelper.LogToCompiler('Internal error - picture list is corrupted - ' + Name);
// write empty size to prevent to corrupt the stream
size := 0;
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(size, SizeOf(size));
end
else
begin
// save the image type in the stream
imgClassName := pList[i].m_pPicture.Graphic.ClassName;
imgNameBytes := TEncoding.UTF8.GetBytes(imgClassName);
size := Length(imgNameBytes);
pStream.WriteBuffer(size, SizeOf(size));
pStream.Write(imgNameBytes, size);
// save the image in the stream
pList[i].m_pPicture.Graphic.SaveToStream(pMemStr);
size := pMemStr.Size;
pStream.WriteBuffer(size, SizeOf(size));
pStream.CopyFrom(pMemStr, 0);
pMemStr.Clear;
end;
// build the key color to save
color := (pList[i].m_ColorKey.GetBlue +
(pList[i].m_ColorKey.GetGreen shl 8) +
(pList[i].m_ColorKey.GetRed shl 16) +
(pList[i].m_ColorKey.GetAlpha shl 24));
// save the key color in the stream
size := SizeOf(color);
pStream.WriteBuffer(size, SizeOf(size));
pStream.WriteBuffer(color, size);
end;
finally
pMemStr.Free;
end;
end;
この問題が発生すると、imgClassName で取得されるコンテンツが一貫性を欠くか、LoadPictureListFromStream() 関数の最初の行で読み取られる画像カウントが 0 になることがあります。
DFM ストリームの内容をファイルに書き込んでいると、クラス名の値だけが壊れていることに気付きました。他のデータは問題ないようです。
この問題はランダムに発生します。特に、設計時にフォームを事前に開かずに実行時にアプリを起動すると、すべてが正常に機能する場合がありますが、何も変更も保存もせずに設計時にフォームを開いたときにも発生する可能性があります。一方、この問題は XE2 でのみ発生します。他のコンパイラではこれに気づきませんでした。
私は Delphi コードを作成している C++ 開発者であり、XE2 でコンパイルできるようにコードの一部を変更する必要があったため ({$if CompilerVersion <= 23} ステートメントを参照)、おそらく非常に多くのことを行っています。記憶に悪いですが、正確にはわかりません。
誰かがこのコードを分析して、私の間違いを教えてもらえますか?