PictureList

[tomkupitz]

Hallo,

ich habe mal experimentell folgende Komp. erstellt:

Code:

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 Register;

implementation

constructor TPictureList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FPicture:=TPicture.Create;
end;

destructor TPictureList.Destroy;
var i: Integer;

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

  Finalize(FPictureArray);

  FPicture.Free;

  inherited Destroy;
end;

//

function TPictureList.GetPictureCount: Integer;
begin
  result:=Length(FPictureArray);
end;

function TPictureList.GetPictureArray(Index: Integer): TPicture;
begin
  if (Index>=0) and (Index<=High(FPictureArray)) and (FPictureArray[Index]<>nil) then
    result:=FPictureArray[Index]
  else
    result:=nil;
end;

//

procedure TPictureList.SetPicture(Value: TPicture);
begin
  SetLength(FPictureArray, Length(FPictureArray)+1);
  FPictureArray[High(FPictureArray)]:=TPicture.Create;
  FPictureArray[High(FPictureArray)].Assign(Value);

  FPicture.Assign(nil);
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;

//

procedure Register;
begin
  RegisterComponents('New', [TPictureList]);
end;

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?

Beste Grüße

[EWeiss]

Habe jetzt nicht alles verfolgt aber ich kann nirgends sehen das du die Stream Position auf 0 setzt.
Bevor du das nächste Picture lädst.

Delphi-Quellcode:

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

Delphi nicht Code Tags wäre angenehmer zu lesen.

gruss

[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!

[EWeiss]

Zumindest hast du
LTemp.Position := 0;
nicht vergessen..

Das ist eins der größten Mankos wenn Leute mit Streams arbeiten.
Wird gern vergessen.

gruss

[peterbelow]

Zitat von EWeiss:

Zumindest hast du
LTemp.Position := 0;
nicht vergessen..

Das ist eins der größten Mankos wenn Leute mit Streams arbeiten.
Wird gern vergessen.

gruss

Stimmt, aber in dem geposteten Kode wäre das definiv kontraindiziert gewesen, da der dort verwendete Stream von der VCL gemanaged wird, es ist der aus dem die Komponenten beim Laden eines Forms aus der Formresource gelesen werden. Beim Aufruf der dem Filer in DefineProperties übergebenen Callbacks steht der Stream definitiv nicht am Anfang sondern an der Position von der die Daten der Komponente geladen werden sollen bzw. and die sie geschrieben werden sollen. Da die Position zu ändern würde alles durcheinanderbringen.

[haentschman]

Moin...

Zitat:

ich habe mal experimentell folgende Komp. erstellt:

Hätte da nicht
MyPictureList := TObjectList<TPicture>.Create(True) auch gereicht? Die Liste bringt alles mit was du möchtest. Count, Zugriff usw.

Zitat:

*.dfm

...übersehen

[Schokohase]

Zitat von peterbelow:

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.

Nein, so pauschal ist das leider nicht richtig.

TPicture speichert selber gar nichts, sondern delegiert das intern an die Graphic-Instanz vom Typ TGraphic .

Delphi-Quellcode:

procedure TPicture.SaveToStream(Stream: TStream);
begin
  if FGraphic <> nil then FGraphic.SaveToStream(Stream);
end;

Und TGraphic.SaveToStream ist deklariert als virtual; abstract; .

Ob und wie die Grafik nun in den Stream geschrieben (oder wieder gelesen) wird, hängt also von der konkreten Implementierung selber ab.

Ein TJPEGImage liest tatsächlich stumpf bis zum Ende, aber ein TBitmap liest wirklich nur sich selbst aus dem Stream.

Trotz allem wird man um deinen Code nicht herum kommen, es sei denn man könnte sicherstellen, dass nur TBitmap Instanzen verwendet werden.

[tomkupitz]

Danke an Peter Below. Das ist die Lösung (getestet).

Dank auch an alle anderen für das Mitdenken.