Discussion :

[Jipété]

Bonjour,

il me semblait l'avoir lu quelque part, je me suis dit que ça avait peut-être un rapport avec cette histoire de fichier 32bitsKC qui, mine de rien, fait 250 de large et donc pas divisible par 8.
Le truc que je ne m'explique pas, c'est que ce fichier 32bitsKC ce n'est pas moi qui le génère, ni mon code, je me contente juste de demander gentiment à Lazarus de l'ouvrir. Bah, l'explication est tout en bas, lire le PS.

Concernant le test rapide ci-dessous, le bouton "Enregistrer..." crée deux fichiers à chaque fois, l'un issu du bitmap de travail et l'autre du TImage d'affichage, les deux sont parfaits et examinés à l'éditeur hexa montrent un PixelFormat à 32.

Image réduite de moitié

Il n'y a rien de plus à dire, juste regarder le gif (qui m'a pourri le joli dégradé gris, )


Quand je pense au temps que j'ai passé, depuis des années, à chercher des bugs dans mes codes alors qu'il n'y en avait pas...
Cœur du code :

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
procedure TForm1.ComputeBitmap;
var
  h, w: integer;
  gray: integer;// ne pas utiliser byte
  ratio:single;
  {$IFDEF WINDOWS}
  row:  pRGBTriple;
  {$ELSE}
  row:  pRGBQuad;
  {$ENDIF}
begin
  ratio:= 255 / (WSIZE + HSIZE);
 
  bmp.BeginUpdate();
  for h := 0 to HSIZE-1 do
  begin
    {$IFDEF WINDOWS}
    row := pRGBTriple(bmp.RawImage.GetLineStart(h));
    {$ELSE} // devrait s'appeler pRGBAQuad...
    row := pRGBQuad(bmp.RawImage.GetLineStart(h));
    {$ENDIF}
 
    for w := 0 to WSIZE-1 do begin
      gray := round((h+w) * ratio);   // calcul du gris
      if gray > 255 then gray := 255;
      {$IFDEF WINDOWS}
      {if bmp.PixelFormat = pf32bit
      then row[w] := RGBtoRGBTriple(gray, gray, gray)
      else }
      row[w] := RGBtoRGBTriple(gray, gray, gray)
      {$ELSE}
      if bmp.PixelFormat = pf32bit
      then row[w] := RGBAtoQuadBGRA(gray, gray, gray, 255)
      else row[w] := RGBAtoQuadRGBA(gray, gray, gray, 255)
      {$ENDIF}
    end;
  end;
  bmp.EndUpdate();
 
  img.Picture.Graphic := bmp;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  HSIZE := 200;
  WSIZE := StrToInt(rdgLargeur.Items[rdgLargeur.ItemIndex]);
  bmp := TBitmap.Create;
  rdgPFClick(nil);
end;
 
procedure TForm1.rdgPFClick(Sender: TObject);
begin
  with bmp do begin
    case rdgPF.ItemIndex of
      0: PixelFormat := pf24bit;
      1: PixelFormat := pf32bit;
    end;
    Height := HSIZE;
    Width  := WSIZE;
  end;
end;
 
procedure TForm1.rdgLargeurClick(Sender: TObject);
begin
  WSIZE := StrToInt(rdgLargeur.Items[rdgLargeur.ItemIndex]);
  bmp.Width := WSIZE;
  img.Width := WSIZE;
  ComputeBitmap;
end;

PS : je retrouve un peu le même défaut en utilisant un programme écrit en Delphi5 (source, adaptée juste ce qu'il faut) qui ne peut correctement afficher que les fichiers dont la largeur est divisible par 8.
Le même problème de rayures verticales est également visible avec la fenêtre de preview de l'OpenPictureDialog.

Et comme je n'ai jamais mis mes mains dans le code de l'opd, le bug n'est donc bien pas de mon fait.

Ce qui est curieux, c'est que 37 n'est pas divisible par 8 mais sa preview est correcte,
pas plus que 3 dont la preview est aussi correcte
ou 397x299, preview correcte
mais 397x1 preview vide !

Bon, je vais préparer un zip... deux dossiers et quelques fichiers : 2projets4div8.zip

[Jipété]

Bonjour,

Bonne nouvelle !

En passant par le TLazIntfImage, plus de rayures avec les largeurs non divisibles par 8 :



J'ai donné dans le post d'origine la procédure ComputeDisplay, voilà donc les modifs à y appliquer, qui consistent en un simple ajout de qq lignes + les variables associées (on notera que le reader n'est plus utilisé, mais je l'ai gardé commenté, au cas où) :

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
  //...
  {$ENDIF}
  // 3 pour lii
  BmpHnd, MaskHnd: HBitmap;
  lii: TLazIntfImage;
  //ReaderBMP: TLazReaderBMP;
begin
  ratio:= 255 / (WSIZE + HSIZE);
 
  // nouveau
  lii := TLazIntfImage.Create(0, 0); // create the raw image
  lii.DataDescription := GetDescriptionFromDevice(0);
  //ReaderBMP := TLazReaderBMP.Create;
  //lii.LoadFromFile(f, ReaderBMP); 
  lii.LoadFromBitmap(bmp.Handle, bmp.Handle, WSIZE, HSIZE);
  lii.CreateBitmaps(BmpHnd, MaskHnd, False);
  // apply handles to the Bitmap
  bmp.Handle     := BmpHnd;   // mod b->bmp
  bmp.MaskHandle := MaskHnd;  // mod id
  // clean up
  //ReaderBMP.Free;
  lii.Free;
 
  // existant
  bmp.BeginUpdate();
  //...

Me reste plus qu'à tester avec tous mes fichiers bizarres, tordus, chelous, etc., mais je tenais à vous faire part de cette victoire, suite à mes mésaventures d'hier.

Bon dimanche,

[Jipété]

En passant par le TLazIntfImage, plus de rayures avec les largeurs non divisibles par 8 :

Bonjour,

je ne sais pas comment j'ai fait pour trouver que le TLazIntfImage s'en sortait bien, dans le post précédent, toujours est-il que ce matin, en travaillant autrement, l'animal ne voulait plus rien savoir.

J'ai fouillé le web et suis tombé sur une discussion fort sympathique ici, avec une solution en béton armé, donc je ne résiste pas au plaisir de la partager.

Il lui manquait juste 4 mots pour qu'elle soit parfaitement compréhensible et qu'on sache exactement de qui on parle, ils sont entre crochets [ ] au point 6 :

I've found an ADMITTEDLY DIRTY workaround:
1) Create your Bitmap as needed, ensuring that its width IS A MULTIPLE OF 8 PIXELS.
2) Work on your bitmap as needed.
3) Obtain a TLazIntfImage from the bitmap.
4) Create another graphical object (I tried only with TPortableNetworkGraphic)
5) Load from the TLazInfImage obtained in step 3.
6) Resize [the another graphical object] as needed (for instance, reduce the width so that it's no longer a multiple of 8 ).
7) Save this graphic.
8) At this point, the image saved will retain its transparency, even though its width is no longer a multiple of 8 pixels.

Partant de son post d'origine avec le code et tout, j'ai pondu ç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
21
22
23
24
25
26
27
28
29
30
procedure TForm1.Button1Click(Sender: TObject);
var
   bmp: TBitmap;
   i,j : integer;
   lazBMP: TLazIntfImage;
begin
   bmp:= TBitmap.Create;
   with bmp do begin
     PixelFormat:=pf32bit;
     //Width  := 100; // origine --> image noire
     Width  := 104; // new ! 104 est divisible par 8 mais plus d'image
     Height := 100;
   end;
   Label1.Caption:='before : '+inttostr(PIXELFORMAT_BPP[bmp.PixelFormat]);
   lazBMP:=bmp.CreateIntfImage;
 
   for i:= 0 to 99 do for j:= 0 to 99 do lazBMP.Colors[i,j] := colYellow;
   for i:=40 to 99 do for j:=40 to 89 do lazBMP.Colors[i,j] := colRed; // for i:=40 to 89 à l'origine mais 99 c'est mieux : collé au bord on voit si ça bouge
   for i:=45 to 55 do for j:=45 to 55 do lazBMP.Colors[i,j] := colTransparent;
 
   bmp.LoadFromIntfImage(lazBMP);
   bmp.Width := 100; // new, et retour à la valeur initialement voulue ////////////// ! \\\\\ -- ici vous pouvez essayer ce qui vous chante
   Label2.Caption:='after  : '+inttostr(PIXELFORMAT_BPP[bmp.PixelFormat]);
 
   lazBMP.free;
   Image1.Picture.Assign(bmp);
   Label3.Caption:='Timage : '+inttostr(PIXELFORMAT_BPP[image1.Picture.Bitmap.PixelFormat]);
   if Checkbox1.Checked then bmp.SaveToFile(Application.Location+'bmpfile.bmp');
   bmp.Free;
end;

J'ai laissé les commentaires pour que vous suiviez bien, et ça donne ça :