PictureList

[peterbelow]

Zitat von tomkupitz:

Hallo,

ich habe mal experimentell folgende Komp. erstellt:

Delphi-Quellcode:

unit PictureList;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

type
  TPictureArray = array of TPicture;
  
  TPictureList = class(TComponent)
  private
    FPicture: TPicture;
    FPictureArray: TPictureArray;

    procedure SetPicture(Value: TPicture);

    function GetPictureCount: Integer;
    function GetPictureArray(Index: Integer): TPicture;

    procedure WritePic(Stream: TStream);
    procedure ReadPic(Stream: TStream);
  protected
    procedure DefineProperties(Filer: TFiler); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property PictureCount: Integer read GetPictureCount;
    property PictureArray[Index: Integer]: TPicture read GetPictureArray;
  published
    property Picture: TPicture read FPicture write SetPicture;
  end;
//....

procedure TPictureList.WritePic(Stream: TStream);
var i: Integer;
    bl: Boolean;

    procedure Write(pic: TPicture);
    begin                       
      pic.SaveToStream(Stream);  
    end;

begin
  i:=Length(FPictureArray);
  Stream.Write(i, sizeof(Integer));

  for i:=0 to High(FPictureArray) do
  begin
    bl:=FPictureArray[i]<>nil;
    Stream.Write(bl, sizeof(Boolean));

    if bl then
      Write(FPictureArray[i]);
  end;
end;

procedure TPictureList.ReadPic(Stream: TStream);
var i: Integer;
    bl: Boolean;

    procedure Read(pic: TPicture);
    begin                           
      pic.LoadFromStream(Stream);   
    end;

begin
  for i:=0 to High(FPictureArray) do
    if FPictureArray[i]<>nil then
    begin
      FPictureArray[i].Free;
      FPictureArray[i]:=nil;
    end;

  //

  Stream.Read(i, sizeof(Integer));
  SetLength(FPictureArray, i);

  for i:=0 to High(FPictureArray) do
  begin
    Stream.Read(bl, sizeof(Boolean));

    if bl then
    begin
      FPictureArray[i]:=TPicture.Create;

      Read(FPictureArray[i]);
    end;
  end;
end;

procedure TPictureList.DefineProperties(Filer: TFiler);
begin
  inherited;

  Filer.DefineBinaryProperty('PictureArray', ReadPic, WritePic, True);
end;

Aber scheinbar kommt nicht alles im Stream an (*.dfm). Ein Aufruf Canvas.Draw(0, 0, PictureList1.PictureArray[Index].Graphic); gelingt (bei 3 geladenen Bildern) für Index=0 für Index>0 aber nicht.

Woran liegt das?

Dein Problem ist, dass TPicture.LoadFromStream nicht so funktioniert wie Du glaubst. Es liest nämlich nicht nur die Zahl von Bytes, die TPicture.SaveToStream geschrieben hat, sondern alles bis zum Ende des Streams. Es wundert mich, dass Du keine stream read fehler bekommst, wenn die Componente geladen wird.

Die Lösung dafür ist folgende Modifikation für deine lokalen Read und Write-Methoden:

Delphi-Quellcode:

    procedure Write(pic: TPicture);
    var
      LTemp: TMemoryStream;
      LSize: int64;
    begin                  
      LTemp:= TMemoryStream.Create;
      try     
        pic.SaveToStream(LTemp); 
        LSize := LTemp.Size; 
        Stream.Write(LSize, sizeof(Lsize));
        LTemp.Position := 0;
        Stream.CopyFrom(LTemp, LSize);
      finally
        LTemp.Free;
      end;
    end;

    procedure Read(pic: TPicture);
    var
      LTemp: TMemoryStream;
      LSize: int64;
    begin                           
      LTemp:= TMemoryStream.Create;
      try     
        Stream.ReadBuffer(LSize, sizeof(Lsize));
        LTemp.CopyFrom(Stream, LSize);
        LTemp.Position := 0;
        pic.LoadFromStream(LTemp);   
      finally
        LTemp.Free;
      end;
    end;

Ungetestet!