Enregistrement d'un bitmap parmi d'autres variables dans un fichier

[Résolu]
Signaler
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
-
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
-
Bonjour,
voici mon problème - il est lié au problème du TObjectList - en fait, je voudrais pouvoir, dans un record, enregistrer dans un fichier un bitmap parmi des shortstrings et d'autres bitmaps (en réalité il s'agit de paquets 1bitmap + 3 shortstring).
Tout va bien, je sais enregistrer le header du fichier, mais ensuite, les bitmaps ne passent pas.
On dirait que un record ne sait pas enregistrer un bitmap ...
Alors j'ai pensé à autre chose : un tableau dynamique à deux dimensions, de taille fixe, qui contiendrait l'information de chaque pixel du bitmap.
J'ai décidé de fixer la limite à 2000px sur 2000px.
Or, la taille du tableau dans le record explose en montant à 12012771 octets (soit plus de 1Mo).
Jusque là j'aurais pu le supporter : mais quand j'essaye d'enregistrer mon record, "Débordement de pile".
Quelqu'un aurait-t-il une solution pour pouvoir enregistrer mes bitmaps sereinement ?  Car j'ai essayé pas mal de trucs, cette technique me semble la plus abordable et néanmoins, elle ne marche que sur des bitmaps de 255px sur 255px maximum ... et c'est pas beaucoup ...

Merci à tous :)

Cordialement, Bacterius !

PS : si vous avez besoin du code je serais heureux de le poster ici.

5 réponses

Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
9
C'est bon, tout marche : en réalité, il fallait passer également FileItemStructure en paramètre var - sinon ça ne change rien - et le bitmap noir bizarre était dû à un défaut d'enregistrement de TStream ... probablement dû au système d'enregistrement.
Enfin bon, ça marche et c'est l'essentiel :)
Reste plus qu'à voir comment augmenter la taille des bitmaps lol.

Merci à tous !

Cordialement, Bacterius !
Messages postés
4720
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
31 juillet 2021
14
tin, vla kecchose qui 'te vré t'interessé à propos des PackedRecord
http://eraquila.iquebec.com/site/delphi/graphic/bitmap2.htm

cantador
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
9
Ah ah ça y est presque : j'ai fixé la limite à 256px sur 256px (pour ce que je veux faire je n'ai pas besoin de plus, mais j'améliorerai plus tard).
Maintenant le bitmap passe : or il passe mal ... lol
Je pense que c'est un problème de traitement de RGB.
En fait, je passe un bitmap bleu, de la taille 256x256, avec quelques taches rouges, jaunes et vertes à l'aérosol au centre et dans le coin haut-gauche.
Or, quand je réouvre mon paquet et que j'ouvre ce bitmap, je me retrouve avec un bitmap tout noir, avec plein de couleurs aérosol mélangées plaquées sur le bord droit.

Voici mon code tout entier (pas optimisé pour l'instant) :






<hr />


unit BitPkg;

interface



uses Windows, SysUtils, Classes, Graphics, Contnrs, Controls, Messages, BitPkgBitmap, Dialogs;



const
 MAXBMPWIDTH=255;
 MAXBMPHEIGHT=255;



type
  TRGBPixel=record
   R, G, B: Byte;
  end;



  TRGBTriple=array [0..2] of Byte;



  TRGBArray = array [0..10000] of TRGBTriple;
  pTRGBArray = ^TRGBArray;



type
  TFileHeader = record
    PkgName : ShortString;  { options a ajouter }
    PkgDescription : ShortString;  { options a ajouter }
    PkgVersion : ShortString;  { options a ajouter }
    PkgAuthor : ShortString;  { options a ajouter }
    ItemCount : Integer;
  end;
  pFileHeader = ^TFileHeader;



const
  FileHeaderSize = SizeOf(TFileHeader);



type
  TFileItem = record
    Bitmap: array [0..MAXBMPWIDTH, 0..MAXBMPHEIGHT] of TRGBPixel;
    Name : ShortString;
    Description : ShortString;
    Author: ShortString;
  end;
  pFileItem = ^TFileItem;



const
  FileItemSize = SizeOf(TFileItem);



type
  TBitPkg=class(TObject)
  // Contenu de TBitPkg
  private
  // Privé
  FBitmaps: TObjectList;
  FPkgName: String;
  FPkgDescription: String;
  FPkgVersion: String;
  FPkgAuthor: String;
  function BitmapToPixels(var Bmp: TBitmap; FileItemStructure: TFileItem): Boolean;
  function PixelsToBitmap(var Bmp: TBitmap; FileItemStructure: TFileItem): Boolean;
  public
  // Public
  constructor Create; overload;
  destructor Destroy; override;
  procedure NewPackage(PkgDescription, PkgVersion, PkgAuthor: String);
  function LoadPackage(AFileName: String): Boolean;
  function SavePackage(AFileName: String): Boolean;
  function GetPackageDescription: String;
  function GetPackageSize: Int64;
  function GetPackageVersion: String;
  function GetPackageAuthor: String;
  function ReadBitmap(Index: Int64; ABitmap: TBitmap; AName, ADescription, AAuthor: String): Boolean;
  function WriteBitmap(ABitmap: TBitmap; AName, ADescription, AAuthor: String): Boolean;
  function ExchangeBitmaps(Index1, Index2: Int64): Boolean;
  function DeleteBitmap(Index: Int64): Boolean;
  property Bitmaps: TObjectList read FBitmaps;
 end;



implementation



constructor TBitPkg.Create;
begin
 inherited Create;
 FBitmaps := TObjectList.Create;
end;



destructor TBitPkg.Destroy;
begin
 FBitmaps.Free;
 inherited Destroy;
end;



procedure TBitPkg.NewPackage(PkgDescription, PkgVersion, PkgAuthor: String);
begin
 FBitmaps.Clear;
 FPkgDescription := PkgDescription;
 FPkgVersion := PkgVersion;
 FPkgAuthor := PkgAuthor;
end;



function TBitPkg.LoadPackage(AFileName: String): Boolean;
var
  FileHeader : TFileHeader;
  FileItem   : TFileItem;
  N          : integer;
  S: TFileStream;
  Bit: TBitPkgBitmap;
  Bmp: TBitmap;
begin
  NewPackage('', '', '');
  S := TFileStream.Create(AFileName, FMOPENREADWRITE);
  S.ReadBuffer(FileHeader, FileHeaderSize);
  S.Position := FileHeaderSize;
  FPkgName := FileHeader.PkgName;
  FPkgDescription := FileHeader.PkgDescription;
  FPkgVersion := FileHeader.PkgVersion;
  FPkgAuthor := FileHeader.PkgAuthor;
  Bmp := TBitmap.Create;
  for N := 0 to FileHeader.ItemCount do
  begin
    S.ReadBuffer(FileItem, FileItemSize);
    Bit := TBitPkgBitmap.Create;
    Bit.FName := FileItem.Name;
    Bit.FDescription := FileItem.Description;
    Bit.FAuthor := FileItem.Author;
    PixelsToBitmap(Bmp, FileItem);
    Bit.FBitmap.Assign(Bmp);
    FBitmaps.Add(Bit);
  end;
  Bmp.Free;
  Result := True;
end;



function TBitPkg.SavePackage(AFileName: String): Boolean;
var
  FileHeader : TFileHeader;
  FileItem   : TFileItem;
  N          : integer;
  S: TFileStream;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  S := TFileStream.Create(AFileName, FMCREATE);
  FileHeader.ItemCount := FBitmaps.Count - 1;
  FileHeader.PkgName := FPkgName;
  FileHeader.PkgDescription := FPkgDescription;
  FileHeader.PkgVersion := FPkgVersion;
  FIleHeader.PkgAuthor := FPkgAuthor;
  S.WriteBuffer(FileHeader, FileHeaderSize);
  S.Position := FileHeaderSize;
  for N := 0 to FBitmaps.Count-1 do
  begin
    FIleItem.Name := TBitPkgBitmap(FBitmaps.Items[N]).FName;
    FIleItem.Description := TBitPkgBitmap(FBitmaps.Items[N]).FDescription;
    FIleItem.Author := TBitPkgBitmap(FBitmaps.Items[N]).FAuthor;
    Bmp.Assign(TBitPkgBitmap(FBitmaps.Items[N]).FBitmap);
    BitmapToPixels(Bmp, FileItem);
    S.WriteBuffer(FileItem, FileItemSize);
  end;
 Bmp.Free;
 S.Free;
 Result := True;
end;



function TBitPkg.BitmapToPixels(var Bmp: TBitmap; FileItemStructure: TFileItem): Boolean;
Var
 Line: PTRGBARRAY;
 X, Y: Integer;
begin
 Bmp.PixelFormat := pf24Bit;
 for X := 0 to Bmp.Height - 1 do
  begin
   Line := Bmp.ScanLine[X];
   for Y := 0 to Bmp.Width - 1 do
    begin
     FileItemStructure.Bitmap[Y, X].R := Line[Y][0];
     FileItemStructure.Bitmap[Y, X].G := Line[Y][1];
     FileItemStructure.Bitmap[Y, X].B := Line[Y][2];
    end;
  end;
  Result := True;
end;



function TBitPkg.PixelsToBitmap(var Bmp: TBitmap; FileItemStructure: TFileItem): Boolean;
Var
 Line: PTRGBARRAY;
 X, Y: Integer;
begin
 Bmp.PixelFormat := pf24Bit;
 Bmp.Height := MAXBMPHEIGHT + 1;
 Bmp.Width := MAXBMPWIDTH + 1;
 for X := 0 to MAXBMPHEIGHT do
  begin
   Line := Bmp.ScanLine[X];
   for Y := 0 to MAXBMPWIDTH do
    begin
     Line[Y][0] := FileItemStructure.Bitmap[Y, X].R;
     Line[Y][1] := FileItemStructure.Bitmap[Y, X].G;
     Line[Y][2] := FileItemStructure.Bitmap[Y, X].B;
    end;
  end;
  Result := True;
end;



function TBitPkg.GetPackageDescription: String;
begin
 Result := FPkgDescription;
end;



function TBitPkg.GetPackageVersion: String;
begin
 Result := FPkgVersion;
end;



function TBitPkg.GetPackageAuthor: String;
begin
 Result := FPkgAuthor;
end;



function TBitPkg.GetPackageSize: Int64;
begin
 Result := FBitmaps.Count;
end;



function TBitPkg.ReadBitmap(Index: Int64; ABitmap: TBitmap; AName, ADescription, AAuthor: String): Boolean;
begin
 Result := False;
 if (not Index in [0..FBitmaps.Count - 1]) then Exit;
 ABitmap.Assign(TBitPkgBitmap(FBitmaps.Items[Index]).FBitmap);
 AName := TBitPkgBitmap(FBitmaps.Items[Index]).FName;
 ADescription := TBitPkgBitmap(FBitmaps.Items[Index]).FDescription;
 AAuthor := TBitPkgBitmap(FBitmaps.Items[Index]).FAuthor;
 Result := True;
end;



function TBitPkg.WriteBitmap(ABitmap: TBitmap; AName, ADescription, AAuthor: String): Boolean;
Var
 Bit: TBitPkgBitmap;
begin
 Bit := TBitPkgBitmap.Create;
 Bit.FBitmap.Assign(ABitmap);
 Bit.FName := AName;
 Bit.FDescription := ADescription;
 Bit.FAuthor := AAuthor;
 FBitmaps.Add(Bit);
 FBitmaps.Pack;
 Result := True;
end;



function TBitPkg.ExchangeBitmaps(Index1, Index2: Int64): Boolean;
begin
 FBitmaps.Exchange(Index1, Index2);
 FBitmaps.Pack;
 Result := True;
end;



function TBitPkg.DeleteBitmap(Index: Int64): Boolean;
begin
 FBitmaps.Delete(Index);
 FBitmaps.Pack;
 Result := True;
end;



end.









<hr />



unit BitPkgBitmap;



interface



uses Windows, SysUtils, Classes, Graphics, Contnrs, Controls, Messages, Dialogs;



type TBitPkgBitmap=class(TObject)
  public
  FBitmap: TBitmap;
  FName: String;
  FDescription: String;
  FAuthor: String;
  constructor Create; overload;
  destructor Destroy; override;
 end;



implementation



constructor TBitPkgBitmap.Create;
begin
 inherited Create;
 FBitmap := TBitmap.Create;
end;



destructor TBitPkgBitmap.Destroy;
begin
 FBitmap.Free;
 inherited Destroy;
end;



end.






<hr />


Merci à tous :)

Cordialement, Bacterius !
Messages postés
4720
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
31 juillet 2021
14
salut Bacterius..
TEST : array of BitMap;
ça compile..

cantador
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
9
Oui cantador ça compile, mais ça ne marche pas ...
Je vais regarder les packed record.

Cordialement, Bacterius !