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