Visualisation d'une image

Version imprimable

14/01/2023, 23h49
_alx_

Visualisation d'une image

Bonsoir,

Je dispose de tableaux d'octets qui représentent des images en niveaux de gris.
Je voudrais les montrer dans un TImage sous FMX.

Je n'ai pas trouvé le moyen de modifier le format initial RGBA obtenu (obligatoirement ?) à la création du bitmap (pour le transformer en format L par exemple).
Ceci même en utilisant TBitmap.Map car le paramètre de format (TPixelFormat) y est en lecture seule.

Une solution possible pourrait être de charger les octets R,G,B à la même valeur et A à $FF, pixel par pixel, mais sans doute au détriment de l'efficacité (en temps d'exécution et taille du bitmap).

Y a-t-il une solution plus simple pour ce problème élémentaire ?

Merci d'avance,
alx
15/01/2023, 07h55
SergioMaster

On pourrait avoir une image d'essai ?
15/01/2023, 10h15
_alx_

2 pièce(s) jointe(s)

Citation:

Envoyé par SergioMaster

On pourrait avoir une image d'essai ?

Mais certainement :
Le zip contient un simple tableau d'octets de dimension 455x436, contenant l'une des couleurs de l'image test bien connue suivante, ici en PNG monochrome (R=G=B).

Pièce jointe 632524
15/01/2023, 12h27
tourlourou

Bonjour,
Si tes images utilisent la palette de 256 niveaux de gris, ont toutes la même taille et que celle-ci ne pose pas de problème de padding par rapport au stockage dans un fichier bitmap, il suffit pê de copier dans un stream l'entête d'un fichier bitmap valide de ce type, puis ton tableau d'octets, avant de faire un LoadFromStream ?
Mais ça fait beaucoup de si...
Sinon, même type de solution en construisant l'en-tête et en ajoutant le padding éventuellement nécessaire.

une solution assez simple pour gérer un tableau de pixel est de produire un Bitmap dans un Stream

Code:

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
 
type
  TRGBQuad = packed record
    rgbBlue: Byte;
    rgbGreen: Byte;
    rgbRed: Byte;
    rgbReserved: Byte;
  end;
 
  TBitmapFileHeader = packed record
    bfType: Word;
    bfSize: DWORD;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: DWORD;
  end;
 
  TBitmapInfoHeader = packed record
    biSize: DWORD;
    biWidth: Longint;
    biHeight: Longint;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: DWORD;
    biSizeImage: DWORD;
    biXPelsPerMeter: Longint;
    biYPelsPerMeter: Longint;
    biClrUsed: DWORD;
    biClrImportant: DWORD;
  end;
 
  TBitmapInfo = record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: array[0..255] of TRGBQuad;
  end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  var BI: TBitmapInfo;
  FillChar(BI, SizeOf(BI), 0);
  BI.bmiHeader.biSize := SizeOf(BI.bmiHeader);
  BI.bmiHeader.biWidth := 455;
  BI.bmiHeader.biHeight := 436;
  BI.bmiHeader.biPlanes := 1;
  BI.bmiHeader.biBitCount := 8;
  BI.bmiHeader.biSizeImage := 456 * 436; // 456 qui est multiple de 4 !
 
  for var I := 0 to 255 do   // palette de gris
  begin
    BI.bmiColors[I].rgbBlue := I;
    BI.bmiColors[I].rgbGreen := I;
    BI.bmiColors[I].rgbRed := I;
    BI.bmiColors[I].rgbReserved := 0;
  end;
 
  var BMF: TBitmapFileHeader;
  BMF.bfType := $4D42;
  BMF.bfOffbits := SizeOf(BMF) + SizeOf(BI);
  BMF.bfSize := BMF.bfOffBits + BI.bmiHeader.biSizeImage;
 
  var F := TMemoryStream.Create;
  F.WriteBuffer(BMF, SizeOf(BMF));
  F.WriteBuffer(BI, SizeOf(BI));
 
  var Dat := TFileStream.Create('..\..\lena455x436-8bit.dat', fmOpenRead);
  var L: TArray<Byte>;
  SetLength(L, 456); // ajouter 1 octet pour avoir des lignes en multiple de 4
  for var Y := 0 to 435 do
  begin
    Dat.Read(L[0], 455);
    F.Write(L[0], 456);  
  end;
  Dat.Free;
 
  F.Position := 0;
 
  Image1.Bitmap.LoadFromStream(F);  // on a maintenant un bête BITMAP
 
  F.Free;
end;

Citation:

Envoyé par Paul TOTH

une solution assez simple pour gérer un tableau de pixel est de produire un Bitmap dans un Stream

Astucieux :P ! ça contourne tous les appels de haut niveau autour de TBitmap.

Mais ça me paraît assez lent, je trouve en moyenne 2 à 3 ms pour afficher cette toute petite image, supposée déjà en mémoire. :(
Code:

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 procedure TForm1.Button1Click(Sender: TObject); begin var t1, t2: int64; tic.StartNew; var Dat := TFileStream.Create('..\lena455x436-8bit.dat', fmOpenRead); var L: TArray<Byte>; SetLength(L, 455*436); Dat.Read(L, 455*436); t1 := tic.GetTimeStamp; for var Y := 0 to 435 do begin F.Write(L[Y*455], 455); F.Position := F.Position + 1; end; Dat.Free; F.Position := 0; Image1.Bitmap.LoadFromStream(F); // on a maintenant un bête BITMAP t2 := tic.GetTimeStamp; Label1.Text := 'elaps: ' + Format('%8u', [t2 - t1]); // ==> 25000 ticks en moyenne, soit 2 à 3 ms. end;

ça donne quoi si tu charges un Bitmap ? tu peux par exemple enregistrer l'image sur disque pour la recharger.

car si je ne m'abuse FMX utilise des textures pour le rendu des bitmap, donc tu as transfert de l'image en mémoire vidéo pour créer une texture, et ce n'est pas forcément une opération très rapide.

quand tu as un bout de code qui semble prendre du temps, il faut toujours vérifier quelle portion est lente, la lecture du .dat, sa conversion, ou finalement le chargement du Stream :)

Code:

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
 
procedure TForm1.FormCreate(Sender: TObject);
var
  t1, t2, t3, t4: Int64;
begin
  t1 := TThread.GetTickCount64;
  var BI: TBitmapInfo;
  FillChar(BI, SizeOf(BI), 0);
  BI.bmiHeader.biSize := SizeOf(BI.bmiHeader);
  BI.bmiHeader.biWidth := 455;
  BI.bmiHeader.biHeight := 436;
  BI.bmiHeader.biPlanes := 1;
  BI.bmiHeader.biBitCount := 8;
  BI.bmiHeader.biSizeImage := 456 * 436; // 456 qui est multiple de 4 !
 
  for var I := 0 to 255 do   // palette de gris
  begin
    BI.bmiColors[I].rgbBlue := I;
    BI.bmiColors[I].rgbGreen := I;
    BI.bmiColors[I].rgbRed := I;
    BI.bmiColors[I].rgbReserved := 0;
  end;
 
  var BMF: TBitmapFileHeader;
  BMF.bfType := $4D42;
  BMF.bfOffbits := SizeOf(BMF) + SizeOf(BI);
  BMF.bfSize := BMF.bfOffBits + BI.bmiHeader.biSizeImage;
 
  var F := TMemoryStream.Create;
  F.WriteBuffer(BMF, SizeOf(BMF));
  F.WriteBuffer(BI, SizeOf(BI));
 
  t2 := TThread.GetTickCount64;
 
  var Dat := TFileStream.Create('..\..\lena455x436-8bit.dat', fmOpenRead);
  var L: TArray<Byte>;
  SetLength(L, 456);
  for var Y := 0 to 435 do
  begin
    Dat.Read(L[0], 455);
    F.Write(L[0], 456);  // ajouter 1 octet pour avoir des lignes en multiple de 4
  end;
  Dat.Free;
 
 
//  F.SaveToFile('BITMAP.BMP');
 
  F.Position := 0;
 
  t3 := TThread.GetTickCount64;
  Image1.Bitmap.LoadFromStream(F);  // on a maintenant un bête BITMAP
  t4 := TThread.GetTickCount64;
 
  F.Free;
  ShowMessage(
    (T2 - T1).ToString + 'ms'#13 +
    (T3 - T2).ToString + 'ms'#13 +
    (T4 - T3).ToString + 'ms'#13 +
    (T4 - t1).ToString + 'ms'
  );
end;

chez moi ça prend 16ms entre t4 et t1, mais tout se passe entre t4 et t3 :)

en regardant le code de LoadFromStream une autre approche est possible

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
  var S := TBitmapSurface.Create;
  S.SetSize(455, 436, TPixelFormat.RGBA);
  var Dat := TFileStream.Create('..\..\lena455x436-8bit.dat', fmOpenRead);
  var Line: TArray<Byte>;
  SetLength(Line, 455);
  for var Y := 435 downto 0 do
  begin
    Dat.Read(Line[0], 455);
    var P: PByte := S.Scanline[y];
    for var x := 0 to 454 do
    begin
      for var c := 0 to 2 do
      begin
        P^ := Line[x];
        Inc(P);
      end;
      P^ := $FF;
      Inc(P);
    end;
  end;
  Image1.Bitmap.Assign(S);
  S.Free;

NB: j'ai testé d'autres PixelFormat mais ça ne donnait pas le résultat attendu, je n'ai pas creusé, mais en RGBA ça fonctionne en tout cas :)