Copie d'image : résultat bon ou mauvais selon le type d'image

**Jipété** · 22/04/2017, 11h42

Bonjour,

Envoyé par Alcatîz

Oui, ce fil de discussion restera dans les annales du forum !

Bien joué pour le post n^o 100

Allez, en route pour le 101^e :

Des nouvelles de l'avancement des combats, en remontant vers l'origine de la discussion, à savoir ce lien chez E-E indiqué dans le premier post, où l'on trouve d'abord la recopie des données d'un Bitmap dans une Array of Bytes, qui servira de source pour la seconde proc, BytesToBitmap.

Mais la première proc coince si la source est un fichier RGBA sur 32 bits, car cette instruction n'est pas prise en compte :

Code :

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

1
2
3
4
case BiPP of // BitsPerPixel, 24 ou 32, récupérée dans BitmapInfoHeader
  24: Bitmap.PixelFormat := pf24bit;
  32: Bitmap.PixelFormat := pf32bit;
end;

Le retour dans le mémo de log montre que le PixelFormat est à 24, et donc bien sûr ce qui s'appuie dessus (le RawImage) est en vrac :

Code :

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

1
2
for h := 0 to Bitmap.Height-1 do
  Move(Bitmap.RawImage.GetLineStart(h)^, Bytes[h*LineSize], LineSize); // copie toute le ligne d'un coup

et je me retrouve avec des pixels moisis à 3 bytes par pixel, donc décalages et tout le toutim.

Est-ce que cette non-modification serait liée au fait que le Bitmap en question est passé à la proc en provenance d'un Image1.Picture.Bitmap ?
Image1 pourtant correctement chargée par

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
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;

et correctement affichée !

Je m'étais déjà rendu compte, en début de diagnostics, il y a 15 jours, que la lecture du PixelFormat de ce Bitmap était à 24 alors que le fichier était à 32, constatation aujourd'hui que je ne peux pas le forcer à la valeur qui m'intéresse. Vais-je être obligé d'utiliser un Bitmap temporaire intermédiaire ?

Vous comprenez maintenant pourquoi ça fait deux semaines qu'on y est...

**BeanzMaster** · 23/04/2017, 00h52

Envoyé par Andnotor

Alors je te le répète une dernière fois : c'est la longueur totale de la ligne qui doit être multiple de 4 octets, pas le pixel.
Pourquoi y aurait-il un Bmp.Width *Bits sinon ?
Le padding est par ligne et non par pixel.

Salut t'enerves pas ok j'ai pigé le coups de la ligne c'est que moi je voyait que le padding s'effectuait à chaque pixel et non juste en fin de ligne
Et comme mon père le dit si bien ce qui est facile à comprendre pour toi ne l'est pas forcement pour l'autre et le faire comprendre est encore plus difficile même si utilises plusieurs façons...la patience vient avec l'apprentissage

Jipete sur ton dernier explemple fonctionnel avec ton image de 5x2 t'arriverais à expliquer le padding en fin de ligne ? Combien il vaut en "byte" 1, 3 ou 4 ? c'est aligné par rapport au RawImage.Description.LineEnd pour comparer.

Et idem ce fil m'a permis d'y plus clair sur tout un tas de petits aspects sur la gestion des bitmaps

Merci A+

**Jipété** · 23/04/2017, 09h23

Salut salut,

Envoyé par BeanzMaster

Jipete sur ton dernier exemple fonctionnel avec ton image de 5x2 t'arriverais à expliquer le padding en fin de ligne ? Combien il vaut en "byte" ~~1, 3 ou 4~~ ? c'est aligné par rapport au RawImage.Description.LineEnd pour comparer.

1, 2 ou 3 plutôt

Dernier exemple fonctionnel :
BiPP = nombre de BitsPerPixel, dans cet exemple comme dans l'autre + bas.

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
// aWidth = longueur de la cible en pixels
LineSize := Trunc(((aWidth * BiPP) +31) /32) *4;  //AVEC alignement -- Andnotor
// en bits par pixel -- un fichier 5x2x24 remonte 16 et padding à 1
// et un 7x1x24 remonte 24 et 3
Padding  := LineSize - (aWidth * (BiPP div 8)); // nbre de bytes nécessaires
//...
bmp.BeginUpdate();
for h := bmp.Height-1 downto 0 do begin
  p4 := pRGBQuad(bmp.RawImage.GetLineStart(h));
  for w := 0 to bmp.Width-1 do begin
    byteR := ms.ReadByte;
    byteG := ms.ReadByte;
    byteB := ms.ReadByte;
    case BiPP of // info de la source
      24: byteA := 255; // padding pour cible 32bits si source = 24bits
      32: byteA := ms.ReadByte;
    end;
    //
    // réservé pour éventuelles modif des bytes
    if ckbxInvertBytes.Checked then begin
      byteR := 255 - byteR;
      byteG := 255 - byteG;
      byteB := 255 - byteB;
      case BiPP of 
        24: byteA := 255; // ne pas l'inverser, sinon image invisible (complètement transparente)
        32: byteA := 255 - byteA;
      end;
    end;
    //
    p4[w] := RGBAtoRGBAQuad(byteR,byteG,byteB,byteA);
  end; // for w -- fin de ligne
  // terminer la ligne avec padding, if any
  if Padding > 0 then
    for w := 0 to Padding -1 do ms.ReadByte; // avance automatique dans le stream source
end; // for h
bmp.EndUpdate();

Le calcul est issu de l'examen attentif de fichiers (en haut 5x1x24, en bas 7x1x24, remplissage avec des pixels jaunes [on notera l'inversion R<>B], matérialisation du padding en rouge) dans un éditeur hexa :
Nom : padding2.png
Affichages : 249
Taille : 31,8 Ko

Nom : padding2.png
Affichages : 249
Taille : 31,8 Ko

Je rappelle que ces fichiers sont issus de MSPaint sous XP sp2.
Et avec un fichier 5x2, le padding d'un byte se répète ligne suivante.

Le problème de la compréhension de ce mécanisme, tout comme le repérage des bytes et donc des pixels, c'est que ce que l'on appelle une "ligne" dans le bitmap n'a rien à voir avec les lignes d'affichage dans l'éditeur hexa : d'abord le bloc de datas commence à l'adresse 36 ici (mais pas toujours), ensuite la première ligne qu'on voit en haut est celle qui est en bas (mais pas toujours) dans l'objet utilisé pour l'affichage, le plus simple pour les débutants c'est d'utiliser des petits fichiers, de faire des copies d'écran comme je fais puis de les imprimer et d'attaquer au crayon-et-gomme, bien souvent j'utilise des crayons de couleurs !

Envoyé par BeanzMaster

Et idem ce fil m'a permis d'y [voir ?] plus clair sur tout un tas de petits aspects sur la gestion des bitmaps

Content de faire avancer le schmilblik, mais on n'est pas au bout de nos peines : il y a des pièges et des chausse-trappes à chaque ligne de code ou presque...
Gag découvert hier :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
tmpbmp:= TBitmap.Create;
case BiPP of
  24: tmpbmp.PixelFormat:=pf24bit;
  32: tmpbmp.PixelFormat:=pf32bit;
end;
tmpbmp.SetSize(bip.bih.biWidth, bip.bih.biHeight);
 
memo1.Lines.Add('tmpbmp.PixelFormat_1  : ' + IntToStr(BytesPerPixel(tmpbmp.PixelFormat))); // --> 4
 
//tmpbmp.Assign(image1.Picture.Bitmap); // fait passer le PixelFormat de 32 à 24
tmpbmp.Canvas.Draw(0,0, image1.Picture.Bitmap); // conserve le PixelFormat
 
memo1.Lines.Add('tmpbmp.PixelFormat_2  : ' + IntToStr(BytesPerPixel(tmpbmp.PixelFormat))); // --> 4 ou 3 selon la ligne précédente activée

Bon dimanche, bon vote !

**Jipété** · 25/04/2017, 18h38

(pouhhh, on en est à la 6^e page !)

Bonsoir,

je viens un peu vous donner des nouvelles et vous parler de l'avancement du projet qui, je le rappelle, consiste à utiliser les 2 procédures Bitmap2Bytes et Bytes2Bitmap trouvables dans le lien du premier post de cette discussion.
L'idée est de jouer sur les bytes entre les deux procédures : fichier1 --> Bitmap2Bytes --> trafic_sur_bytes --> Bytes2Bitmap --> fichier2.

Le challenge, en ce qui me concerne, était d'avoir comme source de Bitmap2Bytes un fichier .bmp, bien sûr, mais décliné en 4 versions :

Code :

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

1
2
3
        | Windows | Linux | 
24 bits |    1    |   2   |
32 bits |    3    |   4   |

Résultat des courses, après pas mal de crises de nerfs, d'engueulades du clavier, de l'écran, des zozos qui ont inventés des trucs aussi tordus et peu compatibles, ça se termine avec une procédure d'environ 150 lignes (quand celle d'origine doit en faire une quinzaine) qui a l'air de fonctionner, tout au moins sous Linux, n'ayant pas encore eu le courage de l'essayer sous Windows car je suis face à un problème monstrueux, dans la seconde procédure, celle qui récupère les Bytes représentant les datas du bitmap dans une Array of Bytes et est sensée recréer le bitmap d'origine : une inversion R<>B qui a l'air de se cacher dans la fonction bmp.SaveToFile, et qu'est-ce qu'on peut faire face à ça ?

Pour le moment, je réfléchis à parcourir toute l'Array of Bytes pour inverser R et B (en fonction de critères d'environnement : l'O.S., 24 ou 32, padding pas padding), ou utiliser RGBTriple/RGBQuad (inversion facile au moment du remplissage) bref, je vais là aussi me retrouver avec 150 à 200 lignes là où l'original n'en avait qu'une douzaine.

Un dernier mot, que j'avais gardé dans un coin pour vous : au cours de mes nombreux tests, j'ai eu la désagréable surprise de constater que remplir un RawImage.Data comme ça (ps est un bête pointeur) ps := source.RawImage.Data; // traite un fichier 32 comme un 24 ! faisait perdre le canal Alpha d'un fichier source le possédant.
C'est le genre de blague qu'on ne détecte pas tout de suite, et bien sûr, l'aide est complètement vide à ce propos...
Et je rappelle que RawImage.Description.Depth remontant parfois des informations farfelues à propos du PixelFormat (charger un TImage avec un fichier 32 bits --> hop ! PF à 24 bits !), autant vous dire que j'ai zappé cette approche pour privilégier celle s'appuyant sur le BitmapInfoHeader, beaucoup plus fiable !

Voilà, je vais y retourner, mais je commence à fatiguer.

**Jipété** · 29/04/2017, 13h12

Bonjour,

Dans le 4^e post page 1 de cette discussion (déjà citée), le monsieur il disait ça :

If you looked at the Rawimage.Description, you will notice the difference.
The bitmap loaded has a bits per pixel of 24 while bitmap 2 has a bits per pixel of 32.
While the depth of both bitmaps are 24bpp, the gtk widgetset internally prefers 4 bytes to store a pixel.
Therefore you cannot simply copy a whole line.

et il montrait du code.
Ça m'intéressait parce que mon Linux est sous gtk.

Je l'ai fait tourner, son code, et à la fin, après l'enregistrement de Bmp2, j'ai juste rajouté 2 lignes, et je ne montre que les différences :

Code :

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

1
2
3
4
5
6
7
8
9
10
ShowMessage(StringReplace(Bmp1.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
//BitsPerPixel=24
//MaskLineEnd=rileWordBoundary
//BytesPerLine->288
//BitsPerLine->2304
ShowMessage(StringReplace(Bmp2.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
//BitsPerPixel=32 <--- While the depth of both bitmaps are 24bpp, gtk prefers 4 bytes to store a pixel.
//MaskLineEnd=rileByteBoundary <---
//BytesPerLine->384
//BitsPerLine->3072

Effectivement, on voit bien que Bmp2.BitsPerPixel est passé à 32. Par quel prodige ? Le monsieur parle de choses internes à gtk, admettons, mais comme je voulais en avoir le cœur net, j'ai examiné le fichier .bmp avec mon éditeur hexa et là, patatras !, le bih.biBitCount est resté à 24 !

Pour confirmer, j'ai commenté ces deux lignes de ShowMessage et j'ai mis à la place :

Code :

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

1
2
3
4
5
6
7
bmp2.FreeImage;
bmp2.LoadFromFile('aa.bmp'); // on recharge 
ShowMessage(StringReplace(Bmp2.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
//BitsPerPixel=24 --> on retombe sur les valeurs du Bmp1
//MaskLineEnd=rileWordBoundary
//BytesPerLine->288
//BitsPerLine->2304

Ce qui veut dire que le Bmp2.SaveToFile vit sa vie indépendamment de gtk, et qu'on n'est pas rendu.

Voilà dans quel univers merveilleux on navigue ! Pas s'étonner qu'on entame la 4^e semaine sur cette affaire...

Que ça ne vous empêche pas de passer un bon week-end prolongé

**BeanzMaster** · 29/04/2017, 14h20

Envoyé par Jipété

Bonjour,

Ce qui veut dire que le Bmp2.SaveToFile vit sa vie indépendamment de gtk, et qu'on n'est pas rendu.

Voilà dans quel univers merveilleux on navigue ! Pas s'étonner qu'on entame la 4^e semaine sur cette affaire...

Et on est loin d'avoir fini. Depuis cette discussion j'ai voulu faire des changements dans mon projet et en concordance avec le dernier tuto de Gilles sur les Enregistrements Etendues et vue que FPC les utilise aussi pour son TRawImage. J'avais dans mon ancien code quelques classes suffisamment simple pour les convertir en enregistrements étendus et la PAF

Certains paramètres genre Width et Height étaient bien assignés dans la procedure dédiée mais une fois sortie de celle-ci les valeurs se remettaient à zero.

Donc m'étonnerai pas que FPC se prenne les pattes lors de la compilation lorsque des enregistrements étendues sont utilisés dans des classes et sous/classes plus complexe.Y a un truc qui cloches c'est sur. Du coup je suis repassé par de bêtes classes et la miracle ça à remarcher sans problèmes et plus d'erreurs dans les paramètres

Bon Week-end également

**Jipété** · 30/04/2017, 12h13

Bonjour,

j'ai trouvé une discussion (non solutionnée, hélas...

), qui pourrait me rapprocher d'une solution.

Je recopie son code ici car j'y ai rajouté deux-trois commentaires et résultats, histoire d'avancer :

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
procedure TForm1.Button5Click(Sender: TObject);
// http://forum.lazarus.freepascal.org/index.php?topic=19802.0
var
  bmp1, bmp2: TBitmap;
  os: string; // utilisé pour enregistrer les fichiers
  function createMyBitmap1():TBitmap;
  var
    RawImage: TRawImage;
    BitmapHandle, MaskHandle: HBitmap;
    Fdata : array [0..9999] of byte;
    i: integer;
  begin
    RawImage.Init;
    RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(50, 50);
    RawImage.Description.LineOrder := riloTopToBottom;
    RawImage.Data:= PByte(FData);
    RawImage.DataSize:= 10000;
    FillByte(fdata[0],10000,255);            // opaque pixels
    for i:=1000 to 1999 do fdata[i*4+3]:=0;  // transparent pixels
    for i:=0000 to 0999 do fdata[i*4+3]:=127;// semitransparent pixels
    // de haut en bas : semitransparent, transparent, opaque
    RawImage_CreateBitmaps(RawImage, BitmapHandle, MaskHandle, False);
    result := TBitmap.Create;
    result.Handle     := BitmapHandle;
    result.MaskHandle := MaskHandle;
    ShowMessage(StringReplace(result.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
// Linux :
//    MaskBitsPerPixel=0
//    MaskBytesPerLine->0
// Windows :
//    MaskBitsPerPixel=1
//    MaskBytesPerLine->8
  end;
 
  function createMyBitmap2():TBitmap;
  var
    pData : PByte;
    i : Integer;
  begin
    result := TBitmap.Create;
    result.PixelFormat:=pf32bit;
    // erreur sous 1.6.rc1 (XP) et 1.6.2 (Debian8) "Error: Argument cannot be assigned to"
    result.RawImage.Description.MaskBitsPerPixel:=0;
    result.SetSize(50,50);
    result.BeginUpdate;
    //result.RawImage.Description.AsString; ?? Kess ça fout là ? Inutile ici
    pdata:=result.RawImage.data;
    FillByte(pdata[0],10000,255);            // opaque pixels
    for i:=1000 to 1999 do pdata[i*4+3]:=0;  // transparent pixels
    for i:=0000 to 0999 do pdata[i*4+3]:=127;// semitransparent pixels
    // de haut en bas : semitransparent, transparent, opaque
    result.EndUpdate;
    ShowMessage(StringReplace(result.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));
// Linux :
//    MaskBitsPerPixel=1
//    MaskBytesPerLine->7
// Windows :
//    MaskBitsPerPixel=1
//    MaskBytesPerLine->8
  end;
begin
  bmp1:=createMyBitmap1();
  bmp2:=createMyBitmap2();
  image1.Picture.Assign(bmp1);
  image2.Picture.Assign(bmp2);
  //enregistrer les fichiers
  {$IFDEF LINUX}
  os := '_LN';
  {$ELSE}
  os := '_XP';
  {$ENDIF}
  bmp1.SaveToFile(FileUtil.ProgramDirectory+'button5/bmp1'+os+'.bmp');
  bmp2.SaveToFile(FileUtil.ProgramDirectory+'button5/bmp2'+os+'.bmp');
  image1.Picture.SaveToFile(FileUtil.ProgramDirectory+'button5/img1'+os+'.bmp');
  image2.Picture.SaveToFile(FileUtil.ProgramDirectory+'button5/img2'+os+'.bmp');
  bmp1.Free;
  bmp2.Free;
  // TRawImage : This object currently is subject to refactoring, don't use it in application code.
  // http://lazarus-ccr.sourceforge.net/docs/lcl/graphtype/trawimage.html
end;

On notera que concernant la compilation ok ou non selon la version de Lazarus, je n'ai absolument pas trouvé où cela était détecté, et on notera également que l'information relative à TRawImage se trouve ici, qu'on peut y lire au début "Source position: graphtype.pp line 201" mais que chez moi, sur 3 fichiers différents (1.4.0, 1.6.rc1 et 1.6.2) la position est en ligne 195.
Si on considère que la seule différence entre 1.4 et 1.6 c'est la correction de deux minuscules fautes d'orthographe, est-ce à dire que la doc du web remonte à la préhistoire de graphtype.pp ?

Ça fait peur quand on lit, tout en bas de la page, "This object currently is subject to refactoring, don't use it in application code."
La page on ne sait pas quand elle a été écrite (aucune date dessus, aucune indication de version

), on ne sait pas si elle est maintenue, on ne sait pas où on va avec ça.

C'est dommage car, si je compare les résultats du code entre XP (à gauche TImage1 dans un TPanel, à droite TImage2 dans un autre TPanel) :
Nom : XP.png
Affichages : 222
Taille : 1,4 Ko

Nom : XP.png
Affichages : 222
Taille : 1,4 Ko

avec ceux de Linux, étant entendu qu'en examinant le code on constate qu'il n'y a aucune possibilité pour modifier la catastrophe affichée à droite, le côté gauche par contre semble prometteur.
Nom : Debian8.png
Affichages : 219
Taille : 2,2 Ko

Nom : Debian8.png
Affichages : 219
Taille : 2,2 Ko

EDIT :

Code :

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

1
2
3
4
5
6
7
8
  function createMyBitmap2():TBitmap;
  var
    pData : PByte;
    i : Integer;
  begin
    result := TBitmap.Create;
    //result.PixelFormat:=pf32bit; // original
    result.PixelFormat:=pf24bit; // image toute blanche

/EDIT

En effet, les diverses initialisations dans createMyBitmap1 semblent porter leurs fruits : l'examen à l'éditeur hexa des fichiers générés montre que la valeur PixelFormat reste enfin à 32 !, après 3 semaines à pleurer qu'elle ne restait pas positionnée...

Dommage qu'il y ait ça sur la page web, concernant TRawImage (oui, je le remets pour bien enfoncer le clou) :

This object currently is subject to refactoring, don't use it in application code.

**Jipété** · 30/04/2017, 15h59

Envoyé par Jipété

La page on ne sait pas quand elle a été écrite (aucune date dessus, aucune indication de version

), on ne sait pas si elle est maintenue, on ne sait pas où on va avec ça.

Et la preuve :

Par exemple, je peux forcer la gestion de l'ordre des pixels en rajoutant cette ligne RawImage.Description.ByteOrder := riboMSBFirst; car si elle n'y est pas Description.AsString retourne ByteOrder=riboLSBFirst (valeur par défaut, sans doute) et les couleurs affichées correspondent à BGRA, or j'utilise Init_BPP32_A8R8G8B8_BIO_TTB(aWidth, aHeight);.

Bien.
Je force donc avec RawImage.Description.ByteOrder := riboMSBFirst; et c'est agréable, plus besoin de réfléchir, yakà lire la string d'Init : A8R8G8B8 --> ARGB affiché,

SAUF QUE Description.AsString continue à retourner ByteOrder=riboLSBFirst *$!§%$£%@#

Pour ne pas mourir idiot, je fais ça, l'un derrière l'autre :

Code :

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

1
2
RawImage.Description.ByteOrder := riboMSBFirst; 
ShowMessage(StringReplace(result.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));

et, non, je ne suis pas idiot, le ShowMessage m'affiche encore et toujours ByteOrder=riboLSBFirst

Suis allé fouiller dans Graphtype.pp, ai trouvé une fonction WriteStr que je ne connaissais pas, c'est elle qui remonte les infos des types énumérés (il y en a plein dans RawImage.Description), j'ai un peu creusé le web et je l'ai testée comme ça :

Code :

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

1
2
3
4
5
6
7
8
9
type
  mytype = (a,b,c);
var
  d : mytype;
  s : string;
begin
  d:=b;
  writestr(s,d);
  caption := s;

elle fonctionne : j'ai "b" en caption. Bien. Alors ? Elle est où, la blague, dans RawImage.Description.AsString ?

C'était mon dernier espoir, ces définitions précises et pointues de RawImage, mais c'est mal barré parce que, oui, ça fonctionne, mais dans un seul sens : selon que j'utilise ByteOrder:=riboLSBFirst ou ByteOrder:=riboMSBFirst le rendu des couleurs n'est pas le même, ce qui est bien et bon, mais j'aimerais quand même savoir où je navigue, quoi.

Que faire, OMG, que faire ?

**tourlourou** · 30/04/2017, 17h51

Envoyé par http://lazarus-ccr.sourceforge.net/docs/lcl/graphtype/trawimagedescription.html

Note: palettes, BitOrder and ByteOrder seem not to be implemented yet.

**Jipété** · 30/04/2017, 23h26

Bonsoir, Yves,

Envoyé par tourlourou

Note: palettes, BitOrder and ByteOrder seem not to be implemented yet.

Oui, cette fichue ligne d'information je l'avais remarquée, mais comme je le disais, on ne sait absolument pas de quand ça date : si ça se trouve ça remonte à la version 0.0.1 du fichier et ça a évolué depuis, sauf la doc, comme bien souvent.
Ou pas.

Comme je l'ai écrit en gras cet après-midi, avec tout ça on ne sait pas où on navigue, et ça c'est le plus tuant, et épouvantablement chronophage, parce qu'il faut tout tester et dans toutes les conditions.

Mais ça, on l'a vu j'en ai déjà parlé, si je charge un fichier dans un TBitmap, le TRawImage va me renvoyer des infos fantaisistes et je trouve qu'il est inadmissible que ça ne soit pas mieux documenté.

Exemple avec le truc de cet aprème, que je torture dans tous les sens : 2 choses changent entre l'image du haut et celle du bas : la couleur dans le panel bleu clair, et la ligne de code au-dessus du ShowMessage, un coup commentée et un coup active : le changement de couleur prouve bien que l'instruction s'est propagée dans les basses couches, mais on peut hélas lire dans le ShowMessage que la dernière ligne visible ici n'a pas changé, à mon grand regret.
Nom : msbcommenté.png
Affichages : 222
Taille : 34,6 Ko

Nom : msbcommenté.png
Affichages : 222
Taille : 34,6 Ko

Nom : msb_actif.png
Affichages : 235
Taille : 34,6 Ko

En plus, des choses ne sont pas expliquées dans l'aide, comme par exemple la ligne Depth=24 dont on se demande à quoi elle sert, heureusement que dessous (non visible sur les images), BitsPerPixel=32, comme demandé par la ligne d'initialisation.

Au plus j'avance, au plus je creuse et au plus je pense que je m'éloigne des exemples simples des codes Delphi (et pour preuve, j'avais demandé à Andnotor une idée du pourquoi du comment je n'arrivais pas à obtenir les mêmes résultats que lui, mais il a botté en touche. Pas folle la guêpe.)

Faudra que je me décide un jour à abandonner l'idée d'arriver à un résultat concluant...

**ThWilliam** · 01/05/2017, 12h22

Salut JP.

Dans ton RawImage.Description, quelles sont les valeurs d'offset : RedShift, GreenShift, BlueShift, AlphaShift ?
En mode BGRA, c'est respectivement : 16 8 0 0

Amicalement
Thierry

**Jipété** · 01/05/2017, 14h02

Salustre, amigo !

Envoyé par ThWilliam

Dans ton RawImage.Description, quelles sont les valeurs d'offset : RedShift, GreenShift, BlueShift, AlphaShift ?
En mode BGRA, c'est respectivement : 16 8 0 0

Quand je parle de ligne active ou commentée, c'est celle dont j'ai causé hier, RawImage.Description.ByteOrder := riboMSBFirst;.

ligne active :
BitsPerPixel=32
RedShift=16
GreenShift=8
BlueShift=0
AlphaShift=0

ligne commentée :
BitsPerPixel=32
RedShift=16
GreenShift=8
BlueShift=0
AlphaShift=0

Tu vois une différence, toi ? Moi pas.

Je rappelle que je lance l'init ainsi RawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(aWidth, aHeight);, ce qui laisse supposer que je suis en BGRA comme ce dont tu parles.

Mais je pensais que cette instruction forçant le ByteOrder aurait une influence, elle l'a puisque les couleurs changent selon que la ligne est active ou commentée, mais c'est la remontée des infos qui est à la ramasse, àmha.

Et le plus dément, en mettant la souris du colorpicker sur ces 2 images, c'est les résultats :
Nom : compar_bgra.png
Affichages : 213
Taille : 1,8 Ko

Nom : compar_bgra.png
Affichages : 213
Taille : 1,8 Ko

à gauche
R 112
G 000
B 255

à droite
R 000
G 112
B 255

Autant dire que si on s'attendait à une inversion R<>B (comm' d'hab', je dirais), ben nan, c'est une inversion R<>G !

À n'y rien comprendre, et confirmé par l'examen à l'éditeur hexa des fichiers bitmap.

Merci de suivre le sujet, bonne fin de week-end,

**BeanzMaster** · 01/05/2017, 14h46

Envoyé par Jipété

Et la preuve :

...
Je force donc avec RawImage.Description.ByteOrder := riboMSBFirst; et c'est agréable, plus besoin de réfléchir, yakà lire la string d'Init : A8R8G8B8 --> ARGB affiché,

SAUF QUE Description.AsString continue à retourner ByteOrder=riboLSBFirst *$!§%$£%@#

Pour ne pas mourir idiot, je fais ça, l'un derrière l'autre :

Code :

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

1
2
RawImage.Description.ByteOrder := riboMSBFirst; 
ShowMessage(StringReplace(result.RawImage.Description.AsString, ' ', LineEnding, [rfReplaceAll]));

et, non, je ne suis pas idiot, le ShowMessage m'affiche encore et toujours ByteOrder=riboLSBFirst

Suis allé fouiller dans Graphtype.pp, ai trouvé une fonction WriteStr que je ne connaissais pas, c'est elle qui remonte les infos des types énumérés (il y en a plein dans RawImage.Description), j'ai un peu creusé le web et je l'ai testée comme ça :

Code :

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

1
2
3
4
5
6
7
8
9
type
  mytype = (a,b,c);
var
  d : mytype;
  s : string;
begin
  d:=b;
  writestr(s,d);
  caption := s;

elle fonctionne : j'ai "b" en caption. Bien. Alors ? Elle est où, la blague, dans RawImage.Description.AsString ?

C'était mon dernier espoir, ces définitions précises et pointues de RawImage, mais c'est mal barré parce que, oui, ça fonctionne, mais dans un seul sens : selon que j'utilise ByteOrder:=riboLSBFirst ou ByteOrder:=riboMSBFirst le rendu des couleurs n'est pas le même, ce qui est bien et bon, mais j'aimerais quand même savoir où je navigue, quoi.

Que faire, OMG, que faire ?

Salut
C'est ce que je disais dans mon dernier message. Il semblerai que FPC se prenne les pieds avec les "Enregistrements Etendus" des qu'ils sont hors du "projet" principale et utilisé dans des unités annexes ou je ne sais quelles raisons obscures.
J'ai eu le même problème avec mes variables qui n'étaient pas assignées correctement. Du coup je suis repassé par de simple Classes et plus de problèmes à ce niveau. Tu m'etonnes que ce soit écrit que la gestion des bitmap va être sujet à changements. Maintenant c'est quand ?

**Jipété** · 05/05/2017, 12h27

Salustre !

Ça avance, laborieusement mais ça avance...
En plein mystère car zéro doc, mais à coups d'essais et gamelles et rateaux, ça avance...

J'ai repris un des codes à l'origine de mes recherches, issu de ce site et je l'ai fait tourner sans problèmes dans une machine virtuelle Win2000 équipée d'un D7 personal ed. et tout s'est bien passé.
Encore heureux, mais il y a des fois on se demande...

Sous Linux, bien que le monsieur précise In this project I use the true color 32 bit format (pf32bit), c'est la misère habituelle quand Scanline fait des siennes :
Nom : capture_oeil_pf24.png
Affichages : 315
Taille : 68,6 Ko

Nom : capture_oeil_pf24.png
Affichages : 315
Taille : 68,6 Ko

(oui, c'est la photo d'un œil, telle que fournie dans le zip.)

J'ai cherché, j'ai fouillé et j'ai trouvé grâce à un ShowMessage judicieusement placé, dans la procédure de chargement du fichier à redimensionner :

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.Button1Click(Sender: TObject); // load picture
begin
  opendialog1.filter := 'bitmaps | *bmp' ;
  if opendialog1.execute then begin
    bm1.loadfromfile(opendialog1.filename);
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))+' '+
                IntToStr(BytesPerPixel(bm2.PixelFormat))); // 3 4 sous L, 4 4 sous W
  end;
end;

3 ça signifie pf24bit et 4, vous l'avez deviné, pf32bit.

Je remets juste les 2 lignes qui me font tomber par terre :

Code :

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

1
2
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // 3 sous Linux, = pf24bit

Imaginez, vous faites i := 5; ShowMessage(IntToStr(i)); et là vous avez tout et n'importe quoi mais pas 5, qu'est-ce que vous en concluriez ?

En désespoir de cause, j'ai essayé de rajouter un TLazIntfImage comme hier (en bas du post, pas de la discussion), puisque ça m'avait réussi :

Code :

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

1
2
3
4
5
6
7
8
9
10
var
  lii: TLazIntfImage;
begin
  opendialog1.filter := 'bitmaps | *bmp' ;
  if opendialog1.execute then begin
    bm1.PixelFormat := pf32bit;
    bm1.loadfromfile(opendialog1.filename); 
    lii := bm1.CreateIntfImage; // ajout
    bm1.LoadFromIntfImage(lii); // ajout
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // toujours 3 sous Linux, = pf24bit

On chauffe (comme dans les jeux de gosses) :
Nom : avec_tlazintfimage.png
Affichages : 303
Taille : 68,2 Ko

mais si je fais

Code :

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

1
2
3
4
5
6
  if opendialog1.execute then begin
    bm1.loadfromfile(opendialog1.filename); 
    lii := bm1.CreateIntfImage; // ajout
    bm1.LoadFromIntfImage(lii); // ajout
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // enfin 4 sous Linux, = pf32bit

c'est une image noire que je gagne. Là on gèle carrément !

(en fait, des tests montrent qu'avec TLazInftImage on peut même se passer de bm1.PixelFormat)
Repartant de l'image colorée ci-dessus, constatant que le rouge et le bleu sont inversés, une modif' s'impose dans la procédure de resize, tout à la fin :

Code :

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

1
2
3
4
5
      //color := sB or (sG shl 8) or (sR shl 16); // avec ça (original) rien d'affiché sous Linux -- img transparente ?
      // D7 : pas gênant que ça soit comme ça (original dessus),"A" pour canal Alpha
      //color := sB or (sG shl 8) or (sR shl 16) or (sA shl 24);
      // dessous pour Linux 
        color := sR or (sG shl 8) or (sB shl 16) or (sA shl 24);

Et là, enfin on brûle !
Nom : final.png
Affichages : 316
Taille : 68,2 Ko

Va falloir jouer avec les {$IFDEF LINUX} pour la suite.

La question qui reste en suspens et pour laquelle il n'y aura jamais de réponse, je crois, c'est : pourquoi mettre un canal Alpha quand PixelFormat est à pf24bit ?
Voili voilou,

**BeanzMaster** · 05/05/2017, 15h45

Envoyé par Jipété

Salustre !

Ça avance, laborieusement mais ça avance...
En plein mystère car zéro doc, mais à coups d'essais et gamelles et rateaux, ça avance...
...
Je remets juste les 2 lignes qui me font tomber par terre :

Code :

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

1
2
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // 3 sous Linux, = pf24bit

Imaginez, vous faites i := 5; ShowMessage(IntToStr(i)); et là vous avez tout et n'importe quoi mais pas 5, qu'est-ce que vous en concluriez ?

Salut,

Etant en plein dedans le BMP comme toi.

Juste pour rire, on peut trouver ça : lcl\IntfGraphics.pas :
Ligne 5080 environ

Code :

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

1
2
3
4
5
6
procedure TLazWriterBMP.Initialize(AImage: TLazIntfImage);
begin
  // set BPP
  // we can also look at PixelFormat, but it can be inexact ! SANS BLAGUES !!!!!!
  BitsPerPixel := AImage.DataDescription.Depth;
end;

Faut mieux laisser tomber le pixelformat et s'appuyer sur la description du rawImage. Le truc que je viens également de remarqué et je n'y avais vraiment pas fais attention.
En realité avec Lazarus il faut distingué 2 méthodes distinctes pour gérer/maniuler les bitmaps:
- 1 directement avec FPC les TFPCustomImage (cf dossier \fpc\3.0.x\source\packages\fcl-image\src)
- 2 avec la LCL et TLazIntfImage cette classe est surement plus fiable que TBitmap. TLazIntfImage descend de TFPCustomImage. Mais piouf elle est pas si simple à prendre en main, suivant ce que l'on désire réaliser.

Envoyé par Jipété

La question qui reste en suspens et pour laquelle il n'y aura jamais de réponse, je crois, c'est : pourquoi mettre un canal Alpha quand PixelFormat est à pf24bit ?
Voili voilou,

Réponse peut dans être dans la description : TRawImageDescription.BitsPerPixel: Byte; // bits per pixel. can be greater than Depth.

C'était ce truc qui m'avait embrouillé avec l'histoire du padding en fin de ligne.

C'etait pour ça que je croyait que le padding se faisait sur chaque pixel
Je pense que la variable PixelFormat est la pour faire le pont avec l'affichage vu qu'ont affiche en 32bits sur nos écrans suivant le format définis par notre OS (Win BGRA / Nux RGBA), ou peut être une histoire de conversion de formats. Mais ou ? je sais pas.

Bref, ce que je peux analyser, ce sont les sources de la LCL qui posent le plus de problèmes. Le soucis à mon avis c'est que c'est beaucoup trop confus et compliqué. Une exemple tout bête (même si je comprend ou les développeurs ont voulu allez) le cas du padding de fin de ligne. Pourquoi mettre ces données dans le RawImage ? Ce paramètres est gérer à la lecture et lors de l'écriture des données vers un flux mémoire ou un fichier (le format BMP en est un parfait exemple)
De plus les fonctions pour calculer la taille d'une ligne en Byte ou Bits sont globales.
En terme de performances et simplifier les échanges, ce genre de paramètres est à mon avis à traiter au cas par cas. Si non il faudrait rajouter un paramètre pour le type de compression aussi.

Plus je travail sur mon projet d'avoir ma propre gestion des bitmaps et plus que j'ai l'impression que tout ce qui est Graphique avec la LCL est bancale . C'est comme si c'était un melting-pot d'idées, de concepts qui sont là comme des sortes de todos qui n'ont jamais été finis. Cette une partie importante, ça serait bon d'avoir quelques chose de fini et pas à moitié.

Je demande ce que diraient mes clients si je leurs servirais des frites juste blanchies ? (j'ai épluché, j'ai taillé, j'ai précuit) pour la cuisson faudra repasser. Je blague mais c'est ça serait bien

Bonne fin de journée

**BeanzMaster** · 05/05/2017, 16h07

Envoyé par Jipété

Salustre !

Ça avance, laborieusement mais ça avance...
En plein mystère car zéro doc, mais à coups d'essais et gamelles et rateaux, ça avance...

J'ai repris un des codes à l'origine de mes recherches, issu de ce site et je l'ai fait tourner sans problèmes dans une machine virtuelle Win2000 équipée d'un D7 personal ed. et tout s'est bien passé.
Encore heureux, mais il y a des fois on se demande...

Sous Linux, bien que le monsieur précise In this project I use the true color 32 bit format (pf32bit), c'est la misère habituelle quand Scanline fait des siennes :
Nom : capture_oeil_pf24.png
Affichages : 315
Taille : 68,6 Ko

(oui, c'est la photo d'un œil, telle que fournie dans le zip.)

J'ai cherché, j'ai fouillé et j'ai trouvé grâce à un ShowMessage judicieusement placé, dans la procédure de chargement du fichier à redimensionner :

Code :

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

1
2
3
4
5
6
7
8
9
10
procedure TForm1.Button1Click(Sender: TObject); // load picture
begin
  opendialog1.filter := 'bitmaps | *bmp' ;
  if opendialog1.execute then begin
    bm1.loadfromfile(opendialog1.filename);
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))+' '+
                IntToStr(BytesPerPixel(bm2.PixelFormat))); // 3 4 sous L, 4 4 sous W
  end;
end;

3 ça signifie pf24bit et 4, vous l'avez deviné, pf32bit.

Je remets juste les 2 lignes qui me font tomber par terre :

Code :

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

1
2
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // 3 sous Linux, = pf24bit

Imaginez, vous faites i := 5; ShowMessage(IntToStr(i)); et là vous avez tout et n'importe quoi mais pas 5, qu'est-ce que vous en concluriez ?

En désespoir de cause, j'ai essayé de rajouter un TLazIntfImage comme hier (en bas du post, pas de la discussion), puisque ça m'avait réussi :

Code :

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

1
2
3
4
5
6
7
8
9
10
var
  lii: TLazIntfImage;
begin
  opendialog1.filter := 'bitmaps | *bmp' ;
  if opendialog1.execute then begin
    bm1.PixelFormat := pf32bit;
    bm1.loadfromfile(opendialog1.filename); 
    lii := bm1.CreateIntfImage; // ajout
    bm1.LoadFromIntfImage(lii); // ajout
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // toujours 3 sous Linux, = pf24bit

On chauffe (comme dans les jeux de gosses) :
Nom : avec_tlazintfimage.png
Affichages : 303
Taille : 68,2 Ko

mais si je fais

Code :

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

1
2
3
4
5
6
  if opendialog1.execute then begin
    bm1.loadfromfile(opendialog1.filename); 
    lii := bm1.CreateIntfImage; // ajout
    bm1.LoadFromIntfImage(lii); // ajout
    bm1.PixelFormat := pf32bit;
    ShowMessage(IntToStr(BytesPerPixel(bm1.PixelFormat))); // enfin 4 sous Linux, = pf32bit

c'est une image noire que je gagne. Là on gèle carrément !

(en fait, des tests montrent qu'avec TLazInftImage on peut même se passer de bm1.PixelFormat)
Repartant de l'image colorée ci-dessus, constatant que le rouge et le bleu sont inversés, une modif' s'impose dans la procédure de resize, tout à la fin :

Code :

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

1
2
3
4
5
      //color := sB or (sG shl 8) or (sR shl 16); // avec ça (original) rien d'affiché sous Linux -- img transparente ?
      // D7 : pas gênant que ça soit comme ça (original dessus),"A" pour canal Alpha
      //color := sB or (sG shl 8) or (sR shl 16) or (sA shl 24);
      // dessous pour Linux 
        color := sR or (sG shl 8) or (sB shl 16) or (sA shl 24);

Et là, enfin on brûle !
Nom : final.png
Affichages : 316
Taille : 68,2 Ko

Va falloir jouer avec les {$IFDEF LINUX} pour la suite.

La question qui reste en suspens et pour laquelle il n'y aura jamais de réponse, je crois, c'est : pourquoi mettre un canal Alpha quand PixelFormat est à pf24bit ?
Voili voilou,

**Jipété** · 08/05/2017, 23h55

Bonsoir,

Ce soir pas de questions, juste un conseil à ceux qui naviguent dans le (vaste !) domaine du graphisme : bricolez-vous un fichier de test avec des dégradés (ah !, Lena...) mais aussi des aplats et du texte, car on a parfois des surprises !

Ces derniers temps, vous m'avez vu jouer avec un œil, ce qui m'a permis d'affiner des routines de redimensionnement récupérées sur le web (comme par exemple la constatation qu'une routine à base de ~~Scanline~~ RawImage.GetLineStart était deux fois plus lente que la même routine à base de purs pointeurs : bon à savoir quand il s'agit de gros fichiers).

Et tout-à-l'heure j'ai voulu comparer mes routines en utilisant mon fichier multi-critères de 800x600 avec une bête réduction à 400x300 et là, c'est sans appel, d'où ce post ! Regardez, en haut la routine pondue par un hollandais un peu déjanté je pense (0 commentaire dans un code passablement illisible et difficilement adaptable, infos ici) et dessous des routines plus ou moins similaires (dont l'une vient de chez Borland [et les gens ont quand même écrit "Gives better results than stretchdraw.", voir + bas], une autre du swissdelphicenter) :
Nom : compar_routines.jpg
Affichages : 98
Taille : 83,9 Ko

Nom : compar_routines.jpg
Affichages : 98
Taille : 83,9 Ko

(et ne vous laissez pas abuser par le côté "flashy" du texte Couleur opposée en jaune sur fond bleu foncé, oui, il "pète" en bas, mieux que l'autre, mais c'est à peu près le seul point positif de l'image du bas...)

Maintenant, faut-il vraiment se prendre la tête avec Scanline, Pointeurs, RawImage et cachets d'aspirine quand, en termes de timing d'exécution et de qualité graphique du rendu, des routines à base du bête StretchDraw font aussi vite et aussi bien que la routine du hollandais ?

**ThWilliam** · 09/05/2017, 12h53

Salut JP.

Je me souviens d'avoir fait des tests de réduction d'image sous Delphi :

StretchDraw : très rapide, mais mauvaise qualité en cas de forte réduction (image trop accentuée)
StretchBlt : très rapide, bonne qualité. (je crois que Linux l'accepte)
Avec GraphicEx : lent, très bonne qualité.

Et sous Lazarus avec BGRABitmap :
SimpleStretch : relativement rapide, mais image un peu floue en cas de forte réduction.
FineInterpolation : lent, très bonne qualité

Tout dépend évidemment du bitmap de base.
Avec un bitmap de 640.000 pixels, la lenteur des meilleures méthodes n'est pas un handicap.
Avec un bitmap de 20 millions de pixels, je privilégie StretchBlt pour un aperçu écran, quitte à faire un meilleur stretch au moment de l'écriture sur fichier.

Amicalement
Thierry

**BeanzMaster** · 09/05/2017, 15h53

Salut JP pour

Le DownSample tu peux essayer ça en modifiant par rapport a ton "systeme"

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
 
//------------------------------------------------------------------------------
// Reduit la taille le bitmap sans perte de qualité
// NB : Attention, Il est nécessaire que le bitmap ait une largeur et une hauteur paire
//------------------------------------------------------------------------------ 
procedure TBZBitmap.DownSample(DestBmp:TBZBitmap;Const Factor:Integer);
Var
 S1, S2 : TBZColorPointer;
 PixelPtr:TBZColorPointer; // identique a PRGBQuad 
 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);
 
 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;
 TmpBmp.Free;
end;

et pour le stretch (exemple de davdata "un peu modifié") les performances sont plus que raisonnable et meilleur que le StretchDraw de la LCL:

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
177
178
179
180
181
182
183
184
185
186
187
188
 
 
procedure KeepAspectRatio(Const SrcW,SrcH:Integer; var NewWidth, NewHeight:Integer);
begin
  // KEEP RATIO
    if SrcW <> SrcH then
        begin
          if SrcH > SrcW then
          begin
           // NewHeight := wHeight;
            NewWidth := (NewHeight * SrcW) div SrcH;
          end
          else
          begin
           // newWidth := wWidth;
            NewHeight := (NewWidth * SrcH) div SrcW;
          end;
        end;
end;
 
//------------------------------------------------------------------------------
// Redimensionne le bitmap vers un autre bitmap sans lissage
//------------------------------------------------------------------------------
Procedure TBZBitmap.Stretch(DestBmp:TBZBitmap;Const NewWidth:Integer;Const NewHeight:Integer;Const KeepRatio:Boolean=false);
Var
  TmpBmp : TBZBitmap;
  NH,NW,SrcW,SrcH,X,Y : Integer;
  //SrcWMax,SrcHMax: Integer;
  destwidth,destheight : Integer;
  fx,fy,fxstep,fystep :Single;
  U, V, U2, V2 : Integer;
  AColor : TBZColor;
  SrcPtr, DstPtr: TBZColorPointer;
begin
  SrcW:= Width;
  SrcH:= Height;
 // SrcWMax:= FMaxPixelWidth; //SrcW-1;
 // SrcHMax:= FMaxPixelHeight; //SrcH-1;
  NW:=NewWidth;
  NH:=NewHeight;
 
  TmpBmp:=TBZBitmap.Create(SrcW,SrcH);
  TmpBmp.Assign(Self);
 
  if KeepRatio then KeepAspectRatio(SrcW,SrcH,NW,NH);
 
  with DestBmp do
  begin
    SetSize(NW,NH);
    Clear(ccolBlack);
  end;
  destwidth := NW-1;
  destheight := NH-1;
  fx := SrcW / NW;
  fy := SrcH /NH;
  fxstep := 0.99999*fx;
  fystep := 0.99999*fy;
  V2:=0;
  DstPtr:=DestBmp.ScanLine(0);
  For Y:=0 to destheight do
  begin
    V := V2;
    V2  := round((fyStep+Y)*fy);
    V:=Clamp(V,0,FMaxPixelHeight);
    U2:=0;
    SrcPtr:=TmpBmp.ScanLine(V);
    For X:=0 to destwidth do
    begin
      U:= U2;
      U2 := round((fxStep+X)*fx);
      U2:=Clamp(U2,0,FMaxPixelWidth);
      AColor:=TBZColorPointer(SrcPtr+U)^;
      DstPtr^:=AColor;
      Inc(DstPtr);
    end;
  end;
  TmpBmp.Free;
end;
 
//------------------------------------------------------------------------------
// Redimensionne le bitmap vers un autre bitmap avec lissage
//------------------------------------------------------------------------------
Procedure TBZBitmap.StretchSmooth(DestBmp:TBZBitmap;Const NewWidth:Integer;Const NewHeight:Integer;Const KeepRatio:Boolean=false);
Var
  TmpBmp : TBZBitmap;
  NW,NH,SrcW,SrcH,X,Y : Integer;
  //, SrcWMax,SrcHMax: Integer;
 
  destwidth,destheight : Integer;
  fx,fy : single;           //factors
  fxstep,fystep : single;
 
  istart,iend, jstart, jend : Integer;
  U, V, U2, V2 : Single;
 
  I,J, C: Integer;
  R,G,B,A :Integer;
 
  sR,sG,sB,sA : byte;
 
  AColor : TBZColor;
  SrcPtr, DstPtr: TBZColorPointer;
begin
  SrcW:= Width;
  SrcH:= Height;
//  SrcWMax:= SrcW-1;
//  SrcHMax:= SrcH-1;
  NW:=NewWidth;
  NH:=NewHeight;
 
  TmpBmp:=TBZBitmap.Create(SrcW,SrcH);
 
  TmpBmp.Assign(self);
 
  if KeepRatio then KeepAspectRatio(SrcW,SrcH,NW,NH);
 
  with DestBmp do
  begin
    SetSize(NW,NH);
    Clear(ccolBlack);
  end;
 
  destwidth := NW-1;
  destheight := NH-1;
  fx := SrcW / NW;
  fy := SrcH /NH;
  fxstep := 0.99999*fx;
  fystep := 0.99999*fy;
 
  V2:=0;
  DstPtr:=DestBmp.ScanLine(0);
  For Y:=0 to destheight  do
  begin
    V := V2;
    jstart:=round(V);
    jstart:=Clamp(jstart,0,FMaxPixelHeight);
    V2  := ((fyStep+Y)*fy);
 
    jend:=round(V2);
    jend:=Clamp(jend,0,FMaxPixelHeight);
    U2:=0;
 
    For X:=0 to destwidth do
    begin
     U:= U2;
     istart:=round(U);
     istart:=Clamp(istart,0,FMaxPixelWidth);
     U2 := ((fxStep+X)*fx);
 
     iend:=round(U2);
     iend:=Clamp(iend,0,FMaxPixelWidth);
 
      R:=0;
      G:=0;
      B:=0;
      A:=0;
      C:=0;
 
      // Lissage depuis les données du fichier sources
 
     SrcPtr:=TmpBmp.ScanLine(jstart-1);
     for j := jstart to jend do  //vertical
     begin
        for i := istart to iend do //horizontal
        begin
          AColor:=TBZColorPointer(SrcPtr+I)^;
          R:=R+AColor.Red;
          G:=G+AColor.Green;
          B:=B+AColor.Blue;
          A:=A+AColor.Alpha;
          Inc(C);
        end;
        Inc(SrcPtr,SrcW);
      end;
 
      if C=0 then C:=1;
 
      sR := ClampByte(round(R/C));;
      sG := ClampByte(round(G/C));
      sB := ClampByte(round(B/C));
      sA := ClampByte(round(A/C));
      DstPtr^:= BZColor(sR,sG,sB,sA);
      Inc(DstPtr);
 
    end;
  end;
  TmpBmp.Free;
end;

Note : On peut encore optimiser un peu en virant les Boucle for Y:=0 to destheight et for X:=0 to destwidth en les remplaçants par un seul repeat ou While..do mais le code est un peu moins lisible et on doit rajouter un IF pour tester les fins de ligne et passer à la suivante.

A+

**Jipété** · 09/05/2017, 18h50

Bonsoir à vous deux et merci pour l'intérêt que vous portez à cette discussion.

Juste deux mots pour dire que je n'ai pas le temps de m'occuper de vos propositions aujourd'hui, mais demain je serai bien plus libre

Copie d'image : résultat bon ou mauvais selon le type d'image [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager