Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 2016
-
13 déc. 2008 à 14:29
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 2016
-
13 déc. 2008 à 17:16
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.
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 13 déc. 2008 à 15:21
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.
Bacterius
Messages postés3792Date d'inscriptionsamedi 22 décembre 2007StatutMembreDernière intervention 3 juin 201610 13 déc. 2008 à 15:02
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) :
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;