Discussion :

[Jipété]

Bonsoir,

je sens que cette vérole va m'occuper tout le week-end (alors que j'avais autre chose à faire...)

Je suis parti des 2 routines qui se trouvent à la fin de cette page, il m'a bien sûr fallu des heures et des heures pour les adapter du monde Delphi à l'univers Lazarus, et bien sûr au bout du compte ça coince et je ne sais plus où chercher.

L'idée c'est de dupliquer un bitmap dans un autre à coups d'array of Byte, GetLineStart (le remplaçant de Scanline) et autres joyeusetés à base de pointeurs.

Sur la copie d'écran (en haut XP, en bas Linux) il y a 3 images : de g. à dr., image1 qui affiche la source, image2 qui affiche(ra) la copie et image3 en contrôle.

Un clic sur le Button1 affiche une OpenPictureDialog permettant de choisir une image ou d'annuler et c'est l'image générée au FormCreate qui sera utilisée comme source de la copie, lancée avec Button2.
Rien de spécial, sauf les résultats :
image source carrée générée par code, tout va bien :


Même code mais générant une image rectangulaire (simple changement de la constante IMAGEHEIGHT), tout va toujours bien SAUF à la clôture sous Windows : access violation alors que FormClose ou FormDestroy sont vides et que les rares objets créés dans les procédures sont détruits en fin de procédure.

Et maintenant la catastrophe, en utilisant un fichier de 128x96 : ok sous Windows, une horreur sous Linux !


Essai avec un fichier carré = même problème, et avec un fichier carré avec des pixels de 32 bits (RGBA) = même problème.
Plus l'access violation à la clôture, encore, sous Windows :

Access violation qui n'existe plus si IMAGEHEIGHT > IMAGEWIDTH mais le processus non fermé continue à tourner en mémoire !

Bref, 3 TImage, 2 TButton, 1 TOpenPictureDialog, le code ci-dessous et le fichier arc-en-ciel : aec_128x96x72.zip

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    opd: TOpenPictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
    procedure Load(Filename: String);
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
uses
  LCLtype; // pour pRGBQuad
 
type
  TMyByteArray = array of Byte;
 
var
  MyBytes: TMyByteArray;
 
function BytesPerPixel(APixelFormat: TPixelFormat): Integer;
begin
  Result := -1;
  case APixelFormat of
    pf8bit : Result := 1;
    pf16bit: Result := 2;
    pf24bit: Result := 3;
    pf32bit: Result := 4;
  end;
end;
 
// pour créer l'image de base, qui sera recopiée
procedure TForm1.FormCreate(Sender: TObject);
const
  IMAGEWIDTH  = 128;
  IMAGEHEIGHT = 128;
var
  h,w: Integer;
  aBmp: TBitmap;
  {$IFDEF WINDOWS}
  p   :  pRGBTriple; // assumes pf24bit scanlines
  {$ELSE}
  p   :  pRGBQuad;   // assumes pf24bit scanlines
  {$ENDIF}
  FUNCTION RGBtoRGBTriple(CONST red, green, blue:  BYTE):  TRGBTriple;
  BEGIN
    WITH RESULT DO
    BEGIN
      rgbtRed   := red;
      rgbtGreen := green;
      rgbtBlue  := blue
    END
  END {RGBtoRGBTriple};
 
  FUNCTION RGBAtoRGBAQuad(CONST red, green, blue, reserved: BYTE): TRGBQuad;
  BEGIN
    WITH RESULT DO BEGIN
      rgbRed   := red;
      rgbGreen := green;
      rgbBlue  := blue;
      rgbReserved := reserved;
    END
  END {RGBAtoRGBAQuad};
begin
  DoubleBuffered := True;
 
  aBmp := TBitmap.Create;
  with aBmp do begin
    PixelFormat := pf24bit;
    SetSize(IMAGEWIDTH, IMAGEHEIGHT);
 
    BeginUpdate();
    for h := 0 to IMAGEHEIGHT-1 do begin
      {$IFDEF WINDOWS}
      p := pRGBTriple(RawImage.GetLineStart(h));
      for w := 0 to IMAGEWIDTH-1 do
        p[w] := RGBtoRGBTriple(h, w, (h+w) div 2);
      {$ELSE}
      p := pRGBQuad(RawImage.GetLineStart(h));
      for w := 0 to IMAGEWIDTH-1 do
        p[w] := RGBAtoRGBAQuad(h, w, (h+w) div 2, 255);
      {$ENDIF}
    end;
    EndUpdate();
 
    image1.Picture.Assign(aBmp);
    Free;
  end;
end;
 
procedure BitmapToBytes(Bitmap: TBitmap; out Bytes: TMyByteArray);
var
  h, BPL, BPP: Integer;
begin
  BPP := BytesPerPixel(Bitmap.PixelFormat)+1; // +1 = /!\ /!\ /!\ /!\
  if BPP < 1 then
    raise Exception.Create('Unknown pixel format');
  SetLength(Bytes, Bitmap.Width * Bitmap.Height * BPP);
  BPL := Bitmap.Width * BPP; // = BytesPerLine
  for h := 0 to Bitmap.Height-1 do
    Move(Bitmap.RawImage.GetLineStart(h)^, Bytes[h * BPL], BPL);
end;
 
// Lazarus ne connait pas CopyMemory, donc Move, mais méfiance à l'ordre des paramètres !
// CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
//   <>  Move(Source^, Destination^, Length);     /!\ /!\ /!\ /!\
 
procedure BytesToBitmap(const Bytes: TMyByteArray; Bitmap: TBitmap;
  aPixelFormat: TPixelFormat; aWidth, aHeight: Integer);
var
  h, BPL, BPP: Integer;
begin
  BPP := BytesPerPixel(aPixelFormat)+1; // +1 = /!\ /!\ /!\ /!\
  if BPP < 1 then
    raise Exception.Create('Unknown pixel format');
  if (aWidth * aHeight * BPP) <> Length(Bytes) then
    raise Exception.Create('Bytes do not match target image properties');
  Bitmap.PixelFormat := aPixelFormat;
  Bitmap.Width  := aWidth;
  Bitmap.Height := aHeight;
  BPL := Bitmap.Width * BPP; // = BytesPerLine
  Bitmap.BeginUpdate();
  for h := 0 to Bitmap.Height-1 do
    Move(Bytes[h * BPL], Bitmap.RawImage.GetLineStart(h)^, BPL);
  Bitmap.EndUpdate();
end;
 
procedure TForm1.Load(Filename: String);
var
 Pict: TPicture;
begin
 Pict := TPicture.Create;
 Pict.LoadFromFile(Filename);
 with image1 do begin
   Width := Pict.Width;
   Height:= Pict.Height;
   Picture.Assign(Pict);
 end;
 Pict.Free
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if opd.Execute then begin
    Image1.Picture := nil;
    Load(opd.FileName);
  end;
  BitmapToBytes(Image1.Picture.Bitmap, MyBytes);
  Caption := 'Copie des datas faite';
  Button2.Enabled:=True;
  Button2.SetFocus;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  BytesToBitmap(MyBytes, Image2.Picture.Bitmap,
    Image1.Picture.Bitmap.PixelFormat,
    Image1.Picture.Bitmap.Width,
    Image1.Picture.Bitmap.Height);
  image3.Picture := image2.Picture; // pour contrôle
end;

Bon, je veux pas dire, hein, mais le graphisme bas niveau et multi-plateforme, c'est vraiment l'enfer

[Jipété]

Bonjour,

je vois que mon histoire n'inspire pas grand monde, et je vous comprends, braves gens, fuyez !
Fuyez le graphisme sous Lazarus, c'est une catastrophe.

Vous ne me croyez pas ? J'en apporte la preuve avec un de mes fichiers de test (96x96), généré avec The Gimp, à qui j'ai demandé un export au format BGRA, en 32 bits, donc.
Le fichier résultant pèse 36 ko (96x96 = 9216, 9216x4 = 36864), puis un export en mode RGB 24 bits, qui pèse 28 ko (9216x3 = 27648).
Ensuite j'ai aussi fait générer deux fichiers depuis le FormCreate (qui crée le dégradé) en mode pf24bit et pf32bit.

Voici le résultat, vu par XnView depuis XP : en haut les fichiers générés par The Gimp, en bas les dégradés enregistrés par Bitmap.SaveToFile tout simplement -- la 3^e ligne est intéressante, elle affiche les dimensions et les bits par pixel.


Résultat identique avec ExifToolGUI (qui s'appuie sur l'excellent ExifTool de Phil Harvey, version 9.39 [pas la dernière]).

Le problème c'est que l'ouverture avec Lazarus des fichiers créés par The Gimp montre une information PixelFormat à 24 bpp, que le fichier soit à 24 ou à 32 bpp, alors que l'information récupérée dans les fichiers créés par le code est correcte. Sectaire, Lazarus ?

Pour récupérer l'information bpp, rien de plus simple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
function BytesPerPixel(aPixelFormat: TPixelFormat): Integer;
begin
  Result := -1;
  case aPixelFormat of
    pf8bit : Result := 1;
    pf16bit: Result := 2;
    pf24bit: Result := 3;
    pf32bit: Result := 4;
  end;
end;
 
procedure TForm1.btnInfosClick(Sender: TObject);
begin
  if opd.Execute then begin
    Image1.Picture := nil;
    Load(opd.FileName); // se charge d'afficher le fichier dans un Timage
    // ledPF est un TLabeledEdit
    ledPF.Text := IntToStr( BytesPerPixel( image1.Picture.Bitmap.PixelFormat )*8 );
  end;
end;

J'en suis là, et j'en conclus que si Lazarus n'est pas capable d'ouvrir correctement des fichiers de provenances diverses, faut pas s'étonner d'avoir des résultats qui ressemblent à rien.
Je n'ai pas creusé plus profond, j'ai l'impression, après avoir traversé du sable, de tomber sur une dalle de granit...

Bon week-end quand même.

[ThWilliam]

Salut JP.

si Lazarus n'est pas capable d'ouvrir correctement des fichiers de provenances diverses...

Sous Windows, je n'ai pas de problèmes notamment avec des fichiers bmp créés sous Photoshop (24 ou 32 bits). Lazarus reconnait bien le pixelformat.
Je ne comprend pas comment tu arrives aux tailles de fichiers précisées. En plus du nombre d'octets concernant les pixels, un bmp a un header (constaté chez moi: 56 octets).

Fuyez le graphisme sous Lazarus, c'est une catastrophe.

Comme je suis amateur de programmation graphique, j'aurais abandonné Lazarus... si la bibliothèque BGRABitmap n'existait pas.

Bon W.E.

Amicalement
Thierry

[Andnotor]

Il y a tout de même des choses surprenantes dans ton code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
PixelFormat := pf24bit;
 
{$IFDEF WINDOWS}
  pRGBTriple()
{$ELSE}
  pRGBQuad()
{$ENDIF}

Pourquoi ce BPP +1 ? Ce n'est pas étonnant qu'il y ait à un moment ou un autre une VA puisque lorsque tu copies depuis le tableau (BytesToBitmap), tu écris au-delà de la fin du bitmap (de bitmap.Width octets).

Quant au rendu, c'est typique d'une image 32 bits traitée (remplie) en 24 bits.

[Jipété]

Il y a tout de même des choses surprenantes dans ton code.

je sais, je sais... Des tests, des essais, des trucs et des machins, des bouts qui restent...

Je change mon fusil d'épaule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
var
  p24   :  pRGBTriple;
  p32   :  pRGBQuad;
begin
  ...
  with aBmp do begin
    PixelFormat := pf24bit;
    //PixelFormat := pf32bit;
    SetSize(IMAGEWIDTH, IMAGEHEIGHT);
 
    BeginUpdate();
    for h := 0 to IMAGEHEIGHT-1 do begin
      if PixelFormat = pf24bit then begin
        p24 := pRGBTriple(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          p24[w] := RGBtoRGBTriple(h*2, w*2, (h*2+w*2) div 2);
      end;
      if PixelFormat = pf32bit then begin
        p32 := pRGBQuad(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          p32[w] := RGBAtoRGBAQuad(h*2, w*2, (h*2+w*2) div 2, 255);
      end;
    end;
    EndUpdate();
 
    image1.Picture.Assign(aBmp);
    aBmp.SaveToFile('c:\savetest24_xp.bmp');
    Free;
  end;

Les résultats : d'abord le pf24bit, puis le 32 -- les fichiers 24 bpp pèsent 49206 octets et les 32 bpp 65590 octets.
Je rappelle qu'il n'y a qu'un seul code dans un dossier partagé accessible aux deux plateformes, tout ce que je change c'est la mise en commentaire d'une ou l'autre ligne PixelFormat := et le nom et le chemin pour aBmp.SaveToFile.


On note deux choses : Linux n'aime pas le RGBTriple, et la couleur du RGBQuad a un souci, selon la plateforme, souci que je règle ainsi (après un test pour déterminer où sont le rouge et le bleu) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
      if PixelFormat = pf32bit then begin
        p32 := pRGBQuad(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          {$IFDEF WINDOWS}
          // Windows = RGB
          //p32[w] := RGBAtoRGBAQuad(255, w*2, (h*2+w*2) div 2, 255); // pour trouver le rouge
          p32[w] := RGBAtoRGBAQuad(h*2, w*2, (h*2+w*2) div 2, 255);
          {$ELSE}
          // Linux = BGR
          //p32[w] := RGBAtoRGBAQuad((h*2+w*2) div 2, w*2, 255, 255); // pour trouver le rouge
          p32[w] := RGBAtoRGBAQuad((h*2+w*2) div 2, w*2, h*2, 255);
          {$ENDIF}
      end;

Salut JP.

Sous Windows, je n'ai pas de problèmes notamment avec des fichiers bmp créés sous Photoshop (24 ou 32 bits). Lazarus reconnait bien le pixelformat.

Salut Thierry,
un peu la flemme de démarrer la MV Win2k juste pour jouer avec un vieux 'toshop dont je ne me souviens pas s'il supporte les 32 bits (v5.5 de 2000 environ).

Je ne comprend pas comment tu arrives aux tailles de fichiers précisées.

Pas grave, c'est pas ça le souci.

En plus du nombre d'octets concernant les pixels, un bmp a un header (constaté chez moi: 56 octets).

Yes I know, le souci (un autre !) c'est que je me suis dit un million de fois qu'il fallait que je me penche sur son exploitation, et c'est à chaque fois remis à demain...

Comme je suis amateur de programmation graphique, j'aurais abandonné Lazarus... si la bibliothèque BGRABitmap n'existait pas.

Je m'accroche car j'ai besoin du multi-plateforme.

Merci pour ces premiers retours, bonne soirée,

EDIT : pour avoir XP et Linux en pf24bit ou pf32bit qui m'affichent 4 fois la même image (celle avec le coin inférieur gauche rose), il me faut faire comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
      if PixelFormat = pf24bit then begin
        {$IFDEF WINDOWS}
        p24 := pRGBTriple(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          p24[w] := RGBtoRGBTriple(h*2, w*2, (h*2+w*2) div 2);
        {$ELSE}
        p32 := pRGBQuad(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          p32[w] := RGBAtoRGBAQuad(h*2, w*2, (h*2+w*2) div 2, 255);
        {$ENDIF}
      end;
      if PixelFormat = pf32bit then begin
        p32 := pRGBQuad(RawImage.GetLineStart(h));
        for w := 0 to IMAGEWIDTH-1 do
          {$IFDEF WINDOWS}
          p32[w] := RGBAtoRGBAQuad(h*2, w*2, (h*2+w*2) div 2, 255);
          {$ELSE}
          p32[w] := RGBAtoRGBAQuad((h*2+w*2) div 2, w*2, h*2, 255);
          {$ENDIF}
      end;

On notera, sous Linux, l'inversion R<>B selon qu'on est en pf24 ou pf32bit

[Jipété]

Bonjour,

Hier soir à pas d'heure j'ai trouvé une procédure qui récupère les infos des BitmapHeaders et les utilise pour afficher l'image.

Alors oui, c'est du Delphi, et rien n'est moins compatible avec Lazarus que du Delphi, le premier annonçant pourtant qu'il est compatible avec le second...

En haut les résultats en partant d'un fichier pf24bit, en bas en partant d'un pf32bit.
À gauche Linux à droite XP
Dans chaque fiche en haut à gauche l'image chargée avec Picture.LoadFromFile, et à droite avec les données récupérées depuis le Header et mises en forme ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
var
  f: file;
  y, rowlength : integer;
  pb : Pointer;
begin
...
  for y := BitmapInfoHeader.biHeight - 1 downto 0 do 
  begin
    //pb := BitMap.ScanLine[y];  {get ^ address of first byte on row}
    // ligne dessus remplacée par dessous pour être en accord avec les warnings du compilo
    pb := BitMap.RawImage.GetLineStart(y);  {get ^ address of first byte on row}
    BlockRead(f, pb^, RowLength, amt);
  end;

En regardant ces 3 lignes de code, je me demande bien ce que je pourrais changer pour que l'image soit correctement affichée...


Et je rappelle que la zone PF est remplie par ledPF.Text:=IntToStr(BytesPerPixel(image1.Picture.Bitmap.PixelFormat)*8);, à comparer avec la ligne Pixel Bit Count remplie avec IntToStr(BitMapInfoHeader.biBitCount );. Voilà, quoi...

Le lien, pour les curieux.
Vous penserez à commenter ce qui a rapport avec Palette, qui n'a pas l'air supporté par Lazarus (pas eu le temps de chercher plus d'infos).

Bon dimanche,

[tourlourou]

Hello !

Je pense que pour recopier des images, il faut descendre aussi bas que possible, Lazarus utilisant des TRawImage pour se rendre indépendant de la plateforme, dont endianess, canal alpha ou pas, RGB ou BGR, etc.
Un simple TBitmap.Create et 2/3 réglages ne doivent pas suffire à assurer une compatibilité entre ces formats de stockage interne, rendant peu opérants (sauf chance) les affectations de Pixels de l'un à l'autre.
Je crains donc qu'il ne faille mettre le nez dedans jusqu'au fond et utiliser les méthodes de lecture et écriture pertinentes des pixels, qui dépendent des infos de TRawImageDescription.
Tout en reconnaissant que tout n'est pas implémenté (voir à la fin)...

[BeanzMaster]

Salut sacré Jipete le soucis c'est que tu trouves que se basé sur fpImage faut pas, etc... et à tu continues à t'enfoncer dans les méandres ,des TRawImages et tout le reste
Je rigole je galère aussi en ce moment avec le chargement de fichier XPM un truc de ouf (et je ne me base pas un poil sur FPC ou Lazarus)

Le 1er petit truc qui me chagrine à la 1ere impression c'est :
- var pb : Pointer;
Essayes PByte ou Transtypes PByte(Pb)

Question : Comment tu initialises ton TPicture c'est important à cause du RawImage Sinon voila comment charger un "pointer" vers un RawImage si cela peux t'aider :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function GetImageBitmap(RawData:Pointer; Width,Height:Integer): Graphics.TBitmap;
var
  Temp:     Graphics.TBitmap;
  RawImage: TRawImage;
  BitmapHandle, MaskHandle: HBitmap;
Begin
  RawImage.Init;
  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(Width, Height);
  RawImage.Description.LineOrder :=riloTopToBottom; //riloBottomToTop ALineOrder;
  RawImage.Data     := PByte(RawData);
  RawImage.DataSize := Width * Height * 4; // 32Bit ;  24Bit = *3
 
    if not RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False) then
    begin
      raise FPImageException.Create('Failed to create bitmap handle');
    end
    else
    begin
     Temp := Graphics.TBitmap.Create;
     Temp.Handle := BitmapHandle;
     Temp.MaskHandle := MaskHandle;
     //ACanvas.StretchDraw(Rect, Temp);
    end;
 
  Result := Temp;
End;

A Bientôt

[Jipété]

Bonsoir, Yves

et merci de t'être penché sur mon cas.

Je n'irai pas par 4 chemins et il n'y a rien contre toi, mais ton lien m'enfonce...

J'ai utilisé la fonction AsString (cool à eux de l'avoir codée) sur mon fichier en pf32bit, et voilà ce qu'elle me retourne (juste les parties utiles, et j'ai rajouté les commentaires en provenance du lien) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
AsString  :  
Width=96 Width of the image in pixels 
Depth=24 Number of used bits per pixel 
BitsPerPixel=24 Number of bits stored per pixel
BytesPerLine->288 The number of bytes per scanline.
BitsPerLine->2304 The number of bits per scanline.

Je rappelle que le farfouillage dans le BitmapInfoHeader me remonte Pixel Bit Count : 32

Plus qu'à tirer l'échelle, après avoir choisi une corde solide...

EDIT : @BeanzMaster : désolé, je n'ai vu ton post qu'après avoir répondu à Yves ; je me penche sur tes suggestions dès que possible, merci à toi.

PS : mais c'est vrai que c'est un truc de malade, et je vois bien sur le web des posts de gens qui galèrent...

[Jipété]

le soucis c'est que tu trouves que se baser sur fpImage faut pas, etc... et à tu continues à t'enfoncer dans les méandres ,des TRawImages et tout le reste

Ben, entre TBitmap, TPicture, TGraphic, TImage, TLazIntfImage, FPImage, le composant lazrgbgraphic (pour lui tous les fichiers sont en 32 bpp), les bgracompos et j'en oublie, et chacun vivant sa petite vie de son côté, c'est vraiment un foutoir total je trouve.

En fait mon idée c'était de pouvoir tester (et utiliser) la montagne de routines écrites en Delphi pour TBitmap qu'on peut trouver sur le web et concernant le redimensionnement des images -- certaines ont l'air très bien fichues, avec ScanLine -- mais impossible de les faire fonctionner correctement : toujours ces histoires de pixels mal alignés se traduisant par des couleurs foireuses, des images déformées, etc.

Question : Comment tu initialises ton TPicture

Comme les exemples le disent :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
var
 Pict: TPicture;
begin
 Pict := TPicture.Create;
 Pict.LoadFromFile(Filename);

Question : Comment tu initialises ton TPicture c'est important à cause du RawImage

Si tu regardes bien le code, tu verras que la seule chose commune aux deux, c'est le nom du fichier choisi dans l'OpenPictureDialog. Sinon, il n'y a aucun rapport entre les deux.

Sinon voila comment charger un "pointer" vers un RawImage si cela peux t'aider :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(Width, Height);

Cela ne m'aide pas du tout car je ne vois pas pourquoi tu utilises BPP32_B8G8R8A8 : tu aurais pu prendre n'importe quelle autre valeur, tu as pris celle-ci dans un but précis parce que tu veux obtenir un résultat que tu maîtriseras.
Pour moi c'est l'inverse : ne sachant pas comment est construit le fichier, il me faut récupérer les données brutes et les analyser, sauf que la récupération se vautre et remonte parfois une bonne valeur et parfois une mauvaise, selon le fichier et la manière d'y accéder.
Je trouve ça complètement insensé.

[Jipété]

Bonjour,

en résumé, ces deux lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
with memo1.Lines.Add do begin
  '(prd) Pixel Bit Count : ' + IntToStr(image1.Picture.Bitmap.RawImage.Description.BitsPerPixel);
  '(bih) Pixel Bit Count : ' + IntToStr(BitMapInfoHeader.biBitCount);
end;

donnent, avec 2 fichiers créés par Lazarus avec Bitmap.SaveToFile, le premier en pf24bit, le second en pf32bit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
(prd) Pixel Bit Count : 24
(bih) Pixel Bit Count : 24
 
(prd) Pixel Bit Count : 32
(bih) Pixel Bit Count : 32

et avec 2 fichiers créés par The Gimp et le même topo 24/32 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
(prd) Pixel Bit Count : 24
(bih) Pixel Bit Count : 24

(prd) Pixel Bit Count : 24
(bih) Pixel Bit Count : 32

Je vais donc essayer de récupérer les données brutes à partir de BitmapFileHeader.bmfBitMapDataOffset et BitMapInfoHeader.biSizeImage, en m'appuyant sur BitMapInfoHeader.biBitCount pour mettre tout ça en ordre.

À suivre...

[BeanzMaster]

Salut,

Ben, entre TBitmap, TPicture, TGraphic, TImage, TLazIntfImage, FPImage, le composant lazrgbgraphic (pour lui tous les fichiers sont en 32 bpp), les bgracompos et j'en oublie, et chacun vivant sa petite vie de son côté, c'est vraiment un foutoir total je trouve.

Ok, ok t'enerves pas, il m'a fallu un peu de temps pour comprendre suite à notre autre discussion "Graphisme pointu". La 1ere chose à comprendre c'est l'ordre de descendance des unités/objets (j'ai passé des heures à parcourir les sources de fpc/et lazarus et il y'a des trucs louches que j'appelle "codes oublié ou fantôme") Bref donc hiérarchiquement nous avons :

1. TCustomFPImage / TRawImage C'est la ou sont stockés toutes les informations relatives du bitmap
2. TLazIntfImage Lui c'est un couche a des fin de conversion de formats en gros
3. TGraphic Cette classe sert à enregistrer (sous Delphi) les différents formats de fichier. Sous Lazarus il est plus généraliste.
4. TBitmap La classe finale pour manipuler les pixels / On peux acceder directement au RawImage. Elle se sert plus ou moins de LazIntf/fpImage
5. TPicture Objet Persistant Juste la pour être publié dans l'inspecteur de propriétés
6. TImage Composant Visuel pour notre bitmap en 32bits à l'écran. Le format des données en interne du bitmap peuvent être codés sur 1bits, 16bits, 24bits, 32bits, 48bits, 64bits

Jusque la je pense que tu es un peu près d'accord ?

En fait mon idée c'était de pouvoir tester (et utiliser) la montagne de routines écrites en Delphi pour TBitmap qu'on peut trouver sur le web et concernant le redimensionnement des images -- certaines ont l'air très bien fichues, avec ScanLine -- mais impossible de les faire fonctionner correctement : toujours ces histoires de pixels mal alignés se traduisant par des couleurs foireuses, des images déformées, etc.

1) Les dimensions :
Lorsque tu lis ou écris un pixel tu doit faire attention à ne pas dépasser les limites exemples un Bitmap de 320x200 sera borné comme suit 0=>X<=319 (320-1) et 0=>Y<=199 (200-1)

2) ScanLine
en Delphi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    MoinPointeur:=Bmp.ScanLine[Y];

devient avec Lazarus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    MoinPointeur:=Bmp.getScanLine(y) ;

3) Avec ScanLine tu utiliseras des "pointer"

C'est la que ça va se compliquer un chouïa. Entre Delphi et FPC l'adressage de la position dans un pointer est un peu différente. Et à mon avis c'est la dessus que tu décroches (il m'a fallu un petit moment pour chopper le truc, donc pas d'inquiétude )

jusque la ça va ?

Bon, C'est en fait facile (Je sais ce qui est facile pour quelqu'un ne l'ai pas forcement pour tout le monde).
Il Faut comprendre comment se déplacer virtuellement et physiquement et comment borner correctement nos données suivant le type choisi pour la lecture ou l'écriture.

Je vais prendre un exemple simple faire un AntiaLiasing / Blur rapidement de le bitmap:

Exemple Delphi provenant de Jan dans la JVCL si je me souviens bien. J'ai commenter un peu le code histoire de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
procedure AntiAliasRect24Bit(clip: tbitmap; XOrigin, YOrigin, XFinal, YFinal: Integer);
var 
    Memo,x,y: Integer; (* Composantes primaires des points environnants *)
    p0,p1,p2:pbytearray;

begin
   if XFinal<XOrigin then begin Memo:=XOrigin; XOrigin:=XFinal; XFinal:=Memo; end;  (* Inversion des valeurs   *)
   if YFinal<YOrigin then begin Memo:=YOrigin; YOrigin:=YFinal; YFinal:=Memo; end;  (* si différence négative*)
   
   // Ici on "clippe" l'acces à nos données. Très important
   XOrigin:=max(1,XOrigin); // minimum toujours 1 a cause de clip.ScanLine [y-1];
   YOrigin:=max(1,YOrigin);
   XFinal:=min(clip.width-2,XFinal); // idem maximum -1+(-1) --> clip.ScanLine [y+1]
   YFinal:=min(clip.height-2,YFinal);

   clip.PixelFormat :=pf24bit;
   for y:=YOrigin to YFinal do 
   begin
    p0:=clip.ScanLine [y-1];
    p1:=clip.scanline [y];
    p2:=clip.ScanLine [y+1];
    for x:=XOrigin to XFinal do 
    begin
      // On fait la moyenne des 4 pixel (x,y-1)+(x,y+1)+(x-1,y)+(x+1,y) ROUGE ou BLEU
      p1[x*3]:=(p0[x*3]+p2[x*3]+p1[(x-1)*3]+p1[(x+1)*3])div 4;
      // On fait la moyenne des 4 pixel (x,y-1)+(x,y+1)+(x-1,y)+(x+1,y) VERTE
      p1[x*3+1]:=(p0[x*3+1]+p2[x*3+1]+p1[(x-1)*3+1]+p1[(x+1)*3+1])div 4;
      // On fait la moyenne des 4 pixel (x,y-1)+(x,y+1)+(x-1,y)+(x+1,y) BLEU ou ROUGE
      p1[x*3+2]:=(p0[x*3+2]+p2[x*3+2]+p1[(x-1)*3+2]+p1[(x+1)*3+2])div 4;
      // On fait la moyenne des 4 pixel (x,y-1)+(x,y+1)+(x-1,y)+(x+1,y) ALPHA 32bit uniquement
      // p1[x*3+3]:=(p0[x*3+3]+p2[x*3+3]+p1[(x-1)*3+3]+p1[(x+1)*3+3])div 4;
      //ou on garde l'alpha p1[x*3+3]:=p0[x*3+3];
      end;
   end;
end;

Comme on peux le voir il a choisis des PByteArray pour recevoir les pixels d'une ligne du bitmap c'est son choix moi j'aime pas

Voila le code convertie vers Lazarus et optimisé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
procedure FastBlur24Bit(RawImage:TRawImage;Dest:TRect);
var
   XOrigin, YOrigin, XFinal, YFinal: Integer;
  DstColor: pRGBTriple; // Format de sortie 24Bits
  xx,yy,totalsize, nextLine:integer;
  Line0, Line2, PixelPtr:pRGBTriple; // Format d'entrée 24bit
  AColor, AColor1, AColor0, AColor2 : TRGBTriple;
begin

  XOrigin := Dest.Left+1;
  YOrigin := Dest.Top;
  Line0 := pRGBTriple(RawImage.GetLineStart(YOrigin)+XOrigin); // On se place sur le 1er pixel en haut à gauche
  PixelPtr:=pRGBTriple(RawImage.GetLineStart(YOrigin+1)+XOrigin); // On se place sur la 2eme ligne
  Line2 :=pRGBTriple(RawImage.GetLineStart(YOrigin+2)+XOrigin); // On se place sur la 3eme ligne
  XFinal := (Dest.Right-Dest.Left) - 2;
  YFinal := (Dest.Bottom-Dest.Top) - 2;
  totalsize:=(XFinal*YFinal);  // On calcul le nombe de pixel total
  inc(XFinal);

  nextLine:=Dest.Left+(Width-Dest.Right);  // On calul de combien incrementer nos "pointer" pour se placer sur au début de la ligne suivante
  xx:=0;
  yy:=0;
  // On parcours les pixels 1 à 1 séquentiellement
  While yy<TotalSize do
  begin
    AColor1:=TRGBTriple(PixelPtr+1)^;
    AColor:=TRGBTriple(PixelPtr-1)^;
    AColor0:=TRGBTriple(Line0)^;
    AColor2:=TRGBTriple(Line2)^;


    // Bon la faut convertir red, green, blue vers rgbRed ou rgbtRed je sais plus....
    DstColor.Red := (AColor0.Red + AColor2.Red + AColor.Red + AColor1.Red)  shr 2;
    DstColor.Green := (AColor0.Green + AColor2.Green + AColor.Green + AColor1.Green) shr 2;
    DstColor.Blue := (AColor0.Blue + AColor2.Blue + AColor.Blue + AColor1.Blue)  shr 2;
    // Alpha
    //DstColor.Alpha:=AColor.Alpha;


    PixelPtr^:=DstColor; // On écrite la nouvelle couleur de notre pixel
    inc(PixelPtr); // On passe au pxiel suivant
    inc(Line0);
    inc(Line2);
    inc(xx);
    // On est arrivé à la fin de la ligne
    if xx>XFinal then
    begin
     xx:=0;
     inc(PixelPtr,NextLine);  // On se place au début de la ligne suivante
     inc(Line0,NextLine);
     inc(Line2,NextLine);
    end;
    inc(yy);
  end;

end;

Bon voila le code est à complété pour rgbt choses. J'ai pas testé ce code avec les RawImage j'ai changé à les variables à la volée mais le concept est là et il fonctionne. Sinon au lieu d'initialiser les lignes avec getScanLine tu peux
directement prendre le pointer Data du TRawImage en référence. en suite je rappel que la formule pour ce place dans le bitmap avec des pointer c'est [X+Y*Largeur]

en cadeau un petit excercice voila ma procedure de DownSample à toi de pointer différemment et changer le TBZBitmap par TBitmap

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
//------------------------------------------------------------------------------
// Reduit la taille le bitmap sans perte de qualité
// NB : Attention, Il est nécessaire que le bitmap ait une largeur et une hauteur paires
// Provient d'un code trouver sur Code-Sources je crois
//------------------------------------------------------------------------------
procedure TBZBitmap.DownSample(DestBmp:TBZBitmap;Const Factor:Integer);
Var
 S1, S2 : TBZColorPointer;
 PixelPtr:TBZColorPointer;
 N, X, Y, W, H,LW: Integer;
 AColor, C1,C2,C3,C4 :TBZColor;
 TmpBmp : TBZBitmap;
begin
 if (Width and 1 = 1) or (Height and 1 = 1) or (factor<=0) then Exit;
 W := CenterX; //Width shr 1;
 H := CenterY; //Height shr 1;
 LW:=Width;
 DestBmp.SetSize(W,H);
 TmpBmp:=TBZBitmap.Create(Width,Height);
 TmpBmp.Assign(self);
// DstTmp:=TBZBitmap.Create(W,H);
 
 for N := 1 to Factor do
 begin
 
  if N>1 then
  begin
   LW:=W;
   TmpBmp.SetSize(W,H);
   TmpBmp.Assign(DestBmp);
   W := W shr 1;
   H := H shr 1;
   DestBmp.SetSize(W,H);
 
  end;
 
  S1 := TmpBmp.ScanLine(0);
  S2 := TmpBmp.ScanLine(1);
 
  PixelPtr:=DestBmp.ScanLine(0);
 
 
  { Pour chaque pixel du bitmap réduit }
  for Y := 0 to H - 1 do
   begin
    for X := 0 to W - 1 do
     begin
      { On prend le carré de 2x2 pixels de l'image originale et l'on calcule le pixel final en
        prenant la moyenne des quatre pixels du carré }
      C1:=TBZColorPointer(S1)^;
 
      C2:=TBZColorPointer(S1+1)^;
 
      C3:=TBZColorPointer(S2)^;
 
      C4:=TBZColorPointer(S2+1)^;
 
      AColor.Red := (C1.Red + C2.Red + C3.Red + C4.Red) shr 2;
      AColor.Green := (C1.Green + C2.Green + C3.Green + C4.Green) shr 2;
      AColor.Blue := (C1.Blue + C2.Blue + C3.Blue + C4.Blue) shr 2;
      AColor.Alpha := (C1.Alpha + C2.Alpha + C3.Alpha + C4.Alpha) shr 2;
      PixelPtr^:=AColor;
 
 
      Inc(S1,2);
      Inc(S2,2);
      Inc(PixelPtr);
     end;
    Inc(S1, LW);
    Inc(S2, LW);
   end;
 end;

Cela ne m'aide pas du tout car je ne vois pas pourquoi tu utilises BPP32_B8G8R8A8 : tu aurais pu prendre n'importe quelle autre valeur, tu as pris celle-ci dans un but précis parce que tu veux obtenir un résultat que tu maîtriseras.

Oui c'est vrai cette procedure est brute de pomme

Effectivement j'ai choisi BPP32_B8G8R8A8 car je teste sous Windows et que c'est son format (d'affichage) et sous Linux il faut choisir BPP32_R8G8B8A8. Donc grâce au procédure Init_BPPxx_... tu peux convertir tes données d'un format à l'autre en prenant soins de prendre en compte bien sur ton format en entrée (24bit, 32bit, bgr,rgb) lors de la lecture
et d'inverser et ou convertir les données.

Pour moi c'est l'inverse : ne sachant pas comment est construit le fichier, il me faut récupérer les données brutes et les analyser, sauf que la récupération se vautre et remonte parfois une bonne valeur et parfois une mauvaise, selon le fichier et la manière d'y accéder.
Je trouve ça complètement insensé.

Personne ne sait comment est construit le fichier. C'est pour çà qu'il faut lire les en-tête de fichier exemple tu lis que ton fichier est codé en 32bit, tu connais ton format (c'est une certitude) d'arrivé c'est 24bit par exemple.
Te suffit donc bien d'analyser les données de ton fichier, puis tu les convertis, et enfin tu les transfert vers ton bitmap. du 32 à 24 juste pas besoin de prendre en compte l'alpha. Ou si tu veux charger l'alpha tu assigne sa valeur vers n'importe quel canal de couleur ou tous pour un niveau de gris. Et pour faire tout ca le mieux c'est de Prendre un TRawImage et de remplir les données à la mano ou accéder aux données avec Scanline et les pointer.

La le plus dure comme tu le dis c'est la manière d'y accéder. Comme je le disais dans mon précédent message, je galérai avec le chargement de fichier XPM (provenant de Gimp et Tres gros 120mo) c'est réglé maintenant
mais c'est compliqué (surtout en accédant au données via pointer, pas évidant de bien se poster suivant) Mais çà c'est une autre histoire je reprendrai ton poste sur les XPM plus tard he ! he ! he!

Voila j'espère que cela va t'aider pour y voir un peu plus clair.

A+

[Andnotor]

je rappel que la formule pour ce place dans le bitmap avec des pointer c'est [X+Y*Largeur]

Pas tout à fait

Ca fonctionnera avec une image de 320 de large (tu es chanceux dans tes tests), mais pas de 319 ou 321. Tu oublies que chaque ligne d'un bitmap est alignée sur 4 octets.

Pour du 24 bits, la taille de la ligne en octet est : LineSize := (Width *3) +(Width mod 4);

[BeanzMaster]

Pas tout à fait

Ca fonctionnera avec une image de 320 de large (tu es chanceux dans tes tests), mais pas de 319 ou 321. Tu oublies que chaque ligne d'un bitmap est alignée sur 4 octets.

Pour du 24 bits, la taille de la ligne en octet est : LineSize := (Width *3) +(Width mod 4);

Comment ca pas tout a fait tu as pas plus mathématique. Non ce que j'aurais du préciser pour eviter toute confusion c'est LARGEUR en Octets ou Byte(s).

Heu ! après que tu sois en 24 ou 32 bit que la largeur en PIXEL soit paire ou impaire c'est la même chose. Tu confond avec l'acces via pointer suivant le type de pointer que tu utilises.
Exemple la variable pour accéder à ton pointer est de type QWord (64bits), dans le cas d'un format ou le pixel est codé sur 32bits, si la largeur est impaire, la il y aura une erreur. La un pixel sera lu en trop (4x8byte = 32bits) et la je suis d'accord avec ton raisonnement. Par contre sur l'accès au Pixel arg, tu me met le doute (juste un peu )

Alors allons y

La plus petite unité pour un pointer est le Byte (PByte)

Donc si tu veux lire un pixel codé en 24bit (r,g,b) 3 Byte ou Octet 1 Byte = 8Bits = 3*8=24
tu va accéder à ton pixel de la façon suivante et quoi qu'il arrive il faut au minimum, c'est même obligatoire de connaitre la taille d'un pixel (1,8,16,24,32,48...bits) pour lire ou écrire :

Allez un petit exemple encore "a la louche" sur la manipulation de bitmap avec des "pointer"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
// Juste des types sympa, quand on les connais
Type
  TRGB24 = packed record
    Rouge, Vert, Bleu : Byte;
  end;
  PRGB24 = ^TRGB24;
 
  TRGB32 = packed record
    Rouge, Vert, Bleu, Alpha : Byte;
  end;
  PRGB32 = ^TRGB32;
 
 
// Ici on accède au Canaux de couleur du pixel Octet (byte) par Octet
function getPixel_Methode_1(Buffer:Pointer;X,Y:Integer):TRGB24;
Var
  PixelPtr : PByte;
begin
 
 PixelPtr:=PByte(Buffer);
 With Result do
 begin
   Rouge:= PixelPtr^;
   Vert:= PByte(PixPtr+1)^;
   Bleu:= PByte(PixPtr+2)^;
end;
 
// Ici on accède au Pixel par paquet de 3 Octet gràce au Record
function getPixel_Methode_2(Buffer:Pointer;X,Y:Integer):TRGB24;
Var
  PixelPtr : PRGB24;
begin
 PixelPtr:=PRGB24(Buffer);
 Result:=PixelPtr^;
end;
 
// juste pour écrire
function clampByte(B:Byte):Byte;
begin
  result:=b;
  if b<0 then result:=0;
  if b>255 then result:=255;
end;
 
// ici je vais prendre une dimension de 321x201 histoire de dire tu peux essayer avec 320x200 attention au bornage dans les boucles for
procedure Convertit_24bit_vers_32bit_et_Ajuste_Luminosité(Buffer:Pointer; var Dest:pointer; Lum : Single);
Var
  SrcPtr : PRGB24;
  DstPtr : PRGB32;
  BytesPerLine24, X,Y : Integer;
  SrcCol : TRGB24;
  DstCol:TRGB32;
  DstSizeInBytes:Longint; //Int64
begin
  SrcPtr:=PRGB24(Buffer);
  DstSizeInBytes = (321*201)*4; //SizeOf(TRGB32)
  ReAllocMem(DstPtr,DstSizeInBytes);
  FillByte(DstPtr,DstSizeInBytes,0);
 
 // BytePerLine:=321*Sizeof(TRGB24) // = 3  nb avec 320 au lieu de 321 çà marche aussi :ptdr:
  For Y:=0 To 200 do //
  Begin
 
     For X:=0 to 320 do // Attention au Bornage
     begin
        SrcCol:=SrcPtr^;
 
        DstCol.Alpha := 255;
        DstCol.Rouge := ClampByte(Trunc(SrcCol.Rouge*Lum));
        DstCol.Vert := ClampByte(Trunc(SrcCol.Vert*Lum));
        DstCol.Bleu := ClampByte(Trunc(SrcCol.Bleu*Lum));
        DstPtr^:=DstCol;
 
       Inc(SrcPtr);
       Inc(DstPtr);
 
        (* AUtre methode avec des PByte au lieu des PTRGBs 
           With SrcCol do
           begin
             Rouge:= PixelPtr^;
             Vert:= PByte(PixPtr+1)^;
             Bleu:= PByte(PixPtr+2)^;
          end;
          DstPtr^:=SrcCol.Rouge;  
          Inc(DstPtr);  // pas besoin si 2eme methode
          DstPtr^:=SrcCol.Vert;  // ou PByte(DstPtr+1)^:=SrcCol.Vert;
          Inc(DstPtr);// idem pas besoin si 2eme methode
          DstPtr^:=SrcCol.Bleu; // ou PByte(DstPtr+2)^:=SrcCol.Bleu
          Inc(DstPtr); // idem pas besoin si 2eme methode
          DstPtr^:=:=255; //  ou PByte(DstPtr+3)^:=SrcCol.Alpha
                    
          Inc(PixelPtr,3); // On passe au pixel suivant ici  sinon on change juste la position de notre SrcPtr cf en dessous
          // Si methode 2 Inc(DstPtr,4);  
        *)
 
     end;
     (*  AUtre methode avec des PByte cf au dessus
         Inc(SrcPtr, BytesPerLine);
     *)
  end;
  Dest :=Pointer(DstPtr);
end;

Voila quoi qu'il en soit faut connaitre depuis et vers quel taille de pixel on doit travailler, c'est indispensable.

[Jipété]

Salut,

Malheureusement je n'avance pas, et je me sens comme un golfeur qui taperait dans sa balle et celle-ci frôlerait à chaque fois le bord du trou sans chuter dedans, et tout ça par la faute au fait que je ne sais sur quels paramètres me baser, pour la bonne et simple raison que par exemple si je regarde la valeur BitmapInfoHeader.biBitCount je trouve 24 pour un fichier, et 32 si je demande Bitmap.RawImage.Description.BitsPerPixel.

Ça m'épuise...

Regardez mon image de test, très agrandie car elle ne fait que 8 x 2 (pratique pour aller voir avec un éditeur hexa) : en haut l'original, dessous le rendu de la copie avec un balayage basé sur l'option usuelle BottomToTop et en bas un balayage inversé, TopToBottom, tel que remonté par Bitmap.RawImage.Description.LineOrder=riloTopToBottom .


EDIT du lendemain :
J'ai généré un fichier de 4 points de couleur, rouge jaune vert noir, il fait donc 4 pixels x 1 ligne, c'est celui qu'on voit en haut de l'image ci-dessous, très agrandie.
Je l'ai généré en 24 et 32 bits, et les 2 lignes suivantes sont les fichiers générés par l'ouverture du fichier de test, et force est de constater qu'il y a deux problèmes :
- inversion du rouge et du bleu sur la ligne du bas ;
- problème d'accès 24 versus 32 octets pour la ligne centrale, qui est la recopie de la version 24 bits.
Le souci (énooooooorme), c'est qu'en regardant le fichier en pf24bit créé par Bitmap.SaveToFile avec un éditeur hexa, la quantité de données (de bytes) est correcte : 3 par pixel.
Alors pourquoi ce sac de nœuds ? On dirait qu'au début de la lecture, si le premier pixel est bien lu (rouge), ce qui est lu ensuite est mauvais : la lecture aurait-elle trop lu (4 bytes au lieu de 3 ?)


Pour ne pas mourir idiot, une vue de l'éditeur hexa, en haut la partie "datas" du fichier source en pf24bit, en bas sa copie générée par le code.

On voit bien en haut (j'ai souligné les 4 pixels avec la couleur utilisée à la création) que R et B sont inversés, c'est pas nouveau.

Mais dessous, d'où sort ce cyan (FF FF 00) si ce n'est du jaune de la source mal lue ?
Genre le système lit 4 bytes au lieu de 3 (00 00 FF 00) et n'en utilise que 3, le pointeur est ensuite sur le premier FF, lit 4 bytes (au lieu de 3) donc FF FF 00 FF et n'utilise dans la cible que les 3 premiers, le pointeur du BlockRead est maintenant sur le byte 00 suivant le byte FF, et comme là tout est à zéro tout se complète par des zéros dans la cible.

On dirait qu'il y a un 'blème dans la fonction BlockRead, parce que je lui demande de lire 3 bytes et pas 4 en mode pf24bit : si le machin fait ce qu'il veut et ne m'écoute pas, on va pas y arriver !

Bon, c'est à confirmer, plus tard dans la journée, là j'ai plus trop le temps.
/EDIT

Je précise que si je recopie à coups de BlockRead/BlockWrite la partie data du fichier original dans un autre, les datas sont exactement celles que je vois avec l'éditeur hexa donc ça, ça fonctionne. C'est les passer dans la structure Bitmap qui sera utilisée pour l'affichage qui pose problème -- et je ne vois absolument pas où.

Je sens bien que je ne suis pas loin, mais les derniers pas seront les plus longs...
(ça me fait penser à un post d'un gars qui avait un souci avec un message d'erreur où il était question de "hit control-c", des gens de Lazarus ont commencé à discuter puis ont abandonné sans aucune explication, laissant l'OP le bec dans l'eau face à son erreur -- merci les gars, ça c'est cool... )

[Andnotor]

@BeanzMaster

J'y vais aussi de ma p'tite démo alors

On va simplement tirer une ligne verticale sur un bitmap en activant uniquement une composante. Une fois sans alignement et une fois avec (c'est une démo Delphi, les pixels sont codés BGR en mémoire).

Deux TImage en stretch pour bien voir ce qui se passe.
Même procédure avec uniquement un calcul différent de la taille de ligne (LineSize).

A noter que la formule Bmp.Width *3 +Bmp.Width mod 4 va pour du 24 bits. Pour supporter tous les formats, il faut compter en bit : Trunc((Bmp.Width *Bits +31) /32) *4.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
function FillImage(aImage :TImage; aSize :integer; aPixelFormat :TPixelFormat; aAlign :boolean) :string;
var
  Bmp  :TBitmap;
  p    :PByte;
  i    :integer;
  Bits :integer;
  LineSize :integer;
 
begin
  Bmp := TBitmap.Create;
  Bmp.SetSize(aSize, aSize);
  Bmp.PixelFormat := aPixelFormat;
 
  case aPixelFormat of
    pf1bit   : Bits := 1;
    pf4bit   : Bits := 4;
    pf8bit   : Bits := 8;
    pf15bit  : Bits := 15;
    pf16bit  : Bits := 16;
    pf24bit  : Bits := 24;
    pf32bit  : Bits := 32;
 
    else Exit;
  end;
 
  if aAlign
  then LineSize := Trunc((Bmp.Width *Bits +31) /32) *4  //AVEC alignement
  else LineSize := (Bmp.Width *Bits) div 8;             //SANS alignement
 
  //Fond noir
  ZeroMemory(Bmp.ScanLine[Bmp.Height -1], Bmp.Height *LineSize);
 
  //Premier pixel (en bas à gauche)
  p := Bmp.ScanLine[Bmp.Height -1];
 
  //Tire une ligne verticale
  for i := 0 to Bmp.Height -1 do
  begin
    p^ := 255;
 
    //Remonte d'une ligne
    inc(p, LineSize);
  end;
 
  aImage.Picture.Assign(Bmp);
 
  Result := IntToStr(LineSize);
 
  Bmp.Free;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
const
  Size = 16;
begin
  Caption := Format('%0:dx%0:d', [Size]);
 
  lNotAlign.Caption := 'Pas aligné, taille=' +FillImage(Image1, Size, pf24bit, FALSE);
  lAlign.Caption    := 'Aligné, taille='     +FillImage(Image2, Size, pf24bit, TRUE);
end;

1er exemple avec une image de 16x16, 24 bits :



Les deux images sont parfaites puisque les tailles des lignes sont multiples de 4 octets.

Maintenant avec une image de 17x17, 24 bits :



Et là, c'est cuit !

Image de gauche sans alignement:

Dès le remplissage du fond noir (ZeroMemory), on constate un problème. La première ligne (qui est en fait la dernière du bloc mémoire) est incomplète.
Le premier pixel (en bas à gauche) est toujours correct (bleu) mais lorsqu'on remonte d'une ligne, il nous manque un octet, il y a décalage et une autre composante s'active. Et ainsi de suite...

Image de droite avec alignement:

Toujours parfaite puisqu'on tient compte de l'alignement systématique des lignes sur 4 octets (quelque soit la profondeur des couleurs).

Encore une de 17x17 mais en 16 bits cette fois-ci:



L'image alignée est toujours bonne et l'autre toujours dans les choux !

C'est mathématique oui, mais il faut tenir compte de l'organisation du format bmp

[BeanzMaster]

Salut

On parle de la même chose Andnotor la manière est différente. De plus réellement "if aAlign then LineSize :=..." n'ai utile que pour les formats 1bit, 4bits et 15bits" pour les autres je ne vois pas le problème d'alignement.

Toit tu te base sur les bits moi je passe par des octets (Byte) par contre il est certain que j'utiliserai ta methode lorsque je commencerai à gérer les formats 1bit, 4bits et 15bits

Toujours parfaite puisqu'on tient compte de l'alignement systématique des lignes sur 4 octets

donc au final c'est sur 32bits

Jipete,

Au premier coup d'oeil ton image de base elle est au format BGR ou RGB car la ca sent un peu l'inversion de canaux regarde dans Bits Order et le format (je ne me rappelle plus du noms des propriétés)
Et on dirait que ton BitmapRawImage n'est pas mis en à jour comme ci le changement de format n'était pas pris en compte (du 32 au 24)
Ensuite Bitmap.RawImage.Description.BitsPerPixel = 32bit car RawImage est utilsé comme tampon pour Afficher ton bitmap à l'écran.

Au lieu de "pb := BitMap.RawImage.GetLineStart(y); {get ^ address of first byte on row}"
as tu essayé de paramétré toi même un rawimage et de l'assigner a ton bitmap ?

[Andnotor]

donc au final c'est sur 32bits

Est-ce que je m'exprime si mal que ça ?
Tu n'es toujours pas convaincu après ma petite démo ?

La ligne est multiple de 4 octets, la taille d'un pixel varie. Il y a un complément (padding en anglais) pour arriver à ce multiple de 4.

La taille mémoire (hors entête) pour une image de 1 pixel est pour :
1 bit = 32 bits ;
15 bits = 32 bits ;
24 bits = 32 bits ;
32 bits = 32 bits.

Pour une image de 2 pixels :
2x 1 bit = 32 bits ;
2x 15 bits = 32 bits ;
2x 24 bits = 64 bits ;
2x 32 bits = 64 bits.

Est-ce plus clair

[Jipété]

Bonsoir,

Je ne vais pas répondre précisément à vos questions et remarques, je vais plutôt montrer comment j'avance.

J'ai bien étudié vos infos, ainsi que l'intérieur de mes fichiers, et constatant que je pataugeais, j'ai pris le taureau par les cornes, et retour aux origines : une machine XP sp2 qui fait tourner un vieux PaintShopPro à qui j'ai demandé de générer 4 fichiers :
1 fichier de 1 pixel rouge ;
1 fichier de 2 pixels rouges ;
1 fichier de 3 pixels rouges ;
1 fichier de 4 pixels rouges.

Bon, le rouge n'est pas vraiment rouge, il tire un peu sur le parme et c'est ce qu'on verra dans la copie d'écran qui reprend les 4 fichiers : 4D 11 FF, il y a quand même pas mal de bleu et, oui, BeanzMaster, R et B sont inversés, je l'ai bien compris.

On profitera de ce magnifique montage pour constater qu'il y a un octet de padding (00) après le pixel unique du premier fichier, qu'il y en a deux dans le deuxième fichier (14 00 [pourquoi "14" ? Ils ont pris ce qu'ils ont trouvé en mémoire ?]), trois (00 00 00) dans le troisième et aucun dans le quatrième, d'où les tailles de fichier identiques pour les deux derniers, 66 octets.

Ensuite j'ai fait tourner ma moulinette de recopie, et dans tous les cas de figure elle se vautre : ici je présente le résultat (très agrandi pour bien voir) à partir du fichier de 4 pixels, une bonne recopie nous afficherait une ligne rouge, on est loin du compte...
Les datas sont en vrac, il en manque (d'où le padding 00 00 00), bref, le foutoir. Vision hexa de la recopie :

Le problème est là.
Plus les infos à la mords-moi-le... Regardez ce que je récupère sur ces 4 fichiers :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
1 fichier de 1 pixel  rouge,  taille 58 o. 
1 fichier de 2 pixels rouges, taille 62 o.
1 fichier de 3 pixels rouges, taille 66 o.
1 fichier de 4 pixels rouges, taille 66 o.

(bih) Height          : 1 <<< ligne identique pour les 4, non répétée pour alléger
(bfh) BitMapDataOffset: 54 <<< idem
(bih) Pixel Bit Count : 24 <<< idem --  The number of bits-per-pixel. d''après Microsoft (MSDN)
on en déduit 24 bits-per-pixel / 8 bits-per-byte = 3 bytes-per-pixel, sauf que...
---
(bih) Width           : 1
(bih) Size Image      : 4 -- The size, in bytes, of the image. d''après Microsoft (MSDN)
????????????????? 4 bytes alors que 24 bits par pixel soit 3 bytes ?
(brid) BytesPerLine   : 4 -- info RawImage
---
(bih) Width           : 2
(bih) Size Image      : 8
(brid) BytesPerLine   : 8 -- info RawImage
---
(bih) Width           : 3
(bih) Size Image      : 12
(brid) BytesPerLine   : 12 -- info RawImage
---
(bih) Width           : 4
(bih) Size Image      : 12 -- là c''est cohérent : 4 pixels de 3 bytes ça fait 12
(brid) BytesPerLine   : 16 -- info RawImage qui persiste et signe à trouver 4 bytes par pixel alors que l''affichage hexa montre bien que ce n''est pas vrai.
---
Conclusion : ne pas utiliser RawImage.Description si on veut des données de calcul fiables.

bih = BitmapInfoHeader, bfh = BitmapFileHeader, brid = Bitmap.RawImage.Description

Et, non, BeanzMaster,

Au lieu de "pb := BitMap.RawImage.GetLineStart(y); {get ^ address of first byte on row}"
as-tu essayé de paramétrer toi-même un rawimage et de l'assigner à ton bitmap ?

je n'ai pas essayé pour la simple raison que je ne vois pas trop comment faire, d'autant plus qu'il me semble que RawImage est en lecture seule (petit cadenas à la complétion de code).
Peut-être tenter l'accès par RawImage.Data ou approchant (j'ai vu des trucs, je me pencherai dessus).
En attendant, effectivement, j'ai correctement pu récupérer les données des fichiers source : "y a plus qu'à", comme on dit...

Quand je pense que quelqu'un sous Delphi aurait fini ça depuis... deux semaines ?

[Jipété]

Pour résumer, une fois que le fichier (1 ligne de 4 pixels presque rouges) est ouvert dans Bitmap, ses datas sont recopiées dans une array of Byte (nommée Bytes dans les deux bouts de code ci-dessous) et les valeurs dedans sont bonnes (partie haute de l'image, où l'on voit bien les 4 pixels à 4D 11 FF qui se suivent).
Recopie des datas avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
BPL := Bitmap.Width * BytesPerPixel(Bitmap.PixelFormat);
for h := 0 to Bitmap.Height-1 do
  Move(Bitmap.RawImage.GetLineStart(h)^, Bytes[h * BPL], BPL);

Pas de test pour savoir s'il faut parcourir l'array de haut en bas ou de bas en haut, on s'en fiche il n'y a qu'une ligne.

Ensuite, dans une autre procédure on va récupérer les données depuis l'array of Byte vers un Bitmap avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
for h := 0 to Bitmap.Height-1 do
  Move(Bytes[h * BPL], Bitmap.RawImage.GetLineStart(h)^, BPL);

puis sauvegarder ce Bitmap dans un fichier avec Bitmap.SaveToFile('path');.

Et là c'est la cata, représentée par la partie basse de l'image : pourquoi les pixels perdent-ils des bytes ?


Je n'ai pas inventé ces codes, je les ai trouvés chez Experts Exchange, j'ose espérer que celui qui les a postés n'a pas posté n'importe quoi, et de toute façon, je viens de tester dans mon vieux w2k-D7 et ça fonctionne tip-top, la ligne rouge est bien là et la vue hexa le confirme :

Ah, ça fonctionne aussi très bien (enfin, juste la ligne rouge de 4 pixels, je n'ai pas testé plus loin) sous XP sp2 et Lazarus 1.6.

Mais ça fonctionne toujours aussi mal avec Laz 1.6.2 / FPC 3.0 sous Debian 8 / Gtk2 (tous les tests précédents et les posts de cette discussion ont été réalisés avec Laz 1.4/FPC 2.6.2 sous Debian 7).

À ce stade, puisque tout le code est identique quelles que soient les plateformes, on pourrait penser à une blague dans le code de move car il n'y a que cette instruction qui tripote les données, je suis allé voir son source mais manque de bol c'est tout codé en assembleur, et je ne cause pas du tout assembleur.

Je ne sais plus quoi faire...