AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

PictureList

Ein Thema von tomkupitz · begonnen am 14. Jun 2019 · letzter Beitrag vom 15. Jun 2019
Antwort Antwort
tomkupitz

Registriert seit: 26. Jan 2011
319 Beiträge
 
Delphi 11 Alexandria
 
#1

PictureList

  Alt 14. Jun 2019, 14:05
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
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#2

AW: PictureList

  Alt 14. Jun 2019, 23:35
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

Geändert von EWeiss (14. Jun 2019 um 23:38 Uhr)
  Mit Zitat antworten Zitat
peterbelow

Registriert seit: 12. Jan 2019
Ort: Hessen
670 Beiträge
 
Delphi 11 Alexandria
 
#3

AW: PictureList

  Alt 15. Jun 2019, 00:01
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!
Peter Below
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#4

AW: PictureList

  Alt 15. Jun 2019, 00:04
Zumindest hast du
LTemp.Position := 0;
nicht vergessen..

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

gruss
  Mit Zitat antworten Zitat
peterbelow

Registriert seit: 12. Jan 2019
Ort: Hessen
670 Beiträge
 
Delphi 11 Alexandria
 
#5

AW: PictureList

  Alt 15. Jun 2019, 00:14
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.
Peter Below
  Mit Zitat antworten Zitat
Benutzerbild von haentschman
haentschman

Registriert seit: 24. Okt 2006
Ort: Seifhennersdorf / Sachsen
5.275 Beiträge
 
Delphi 12 Athens
 
#6

AW: PictureList

  Alt 15. Jun 2019, 09:09
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

Geändert von haentschman (15. Jun 2019 um 09:27 Uhr)
  Mit Zitat antworten Zitat
Schokohase
(Gast)

n/a Beiträge
 
#7

AW: PictureList

  Alt 15. Jun 2019, 10:00
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.
  Mit Zitat antworten Zitat
tomkupitz

Registriert seit: 26. Jan 2011
319 Beiträge
 
Delphi 11 Alexandria
 
#8

AW: PictureList

  Alt 15. Jun 2019, 15:31
Danke an Peter Below. Das ist die Lösung (getestet).

Dank auch an alle anderen für das Mitdenken.
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 07:55 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz