Discussion :

[tintin62]

bonjour
j'ai chargé une image sur un Timage en FMX
et je voudrais savoir ou je clique sur image que sa me renvoi
la couleur du pixel
j'ai fait sa mais je ne vois pas le problème
car sa me renvoi au RGB toujours le valeur 255
merci avance de votre aide

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
 
unit Unit1;
 
interface
 
uses
 
  System.SysUtils, System.UIConsts, System.Types, System.UITypes,
  System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo.Types, FMX.ScrollBox,
  FMX.Memo,
  FMX.Edit, FMX.EditBox, FMX.NumberBox, System.Math, System.Math.Vectors,
  FMX.Layouts, System.Actions, FMX.ActnList, FMX.Media, mmsystem, FMX.ComboEdit,
  FMX.Colors,FMX.Surfaces;
 
 
 
 
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Memo1: TMemo;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
 
    procedure ImageLoadFromFile(filename: string; MyImage: TImage);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
procedure TForm1.ImageLoadFromFile(filename: string; MyImage: TImage);
var
  bmp: fmx.graphics.tbitmap;
  astream: tmemorystream;
  surface: tbitmapsurface;
begin
  bmp := FMX.Graphics.TBitmap.Create;
  bmp.LoadFromFile(filename);
  astream:=tmemorystream.Create;
  surface:=tbitmapsurface.Create;
  surface.Assign(bmp);
  try
    tbitmapcodecmanager.SaveToStream(astream,surface,'bmp');
    astream.Seek(0,tseekorigin.soBeginning);
    MyImage.bitmap.LoadFromStream(astream);
  finally
    astream.free;
    bmp.free;
    surface.free
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
filen:string;
begin
 
filen:='carte.jpg';
Form1.ImageLoadFromFile(filen,form1.Image1);
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
 
var
  vBitMapData : TBitmapData;
  PixelColor : TAlphaColor;
  xx,yy:integer;
 
begin
xx:=round(x);
yy:=round(y);
 
image1.Bitmap.Map(TMapAccess.Read, vBitMapData) ;
 PixelColor := vBitMapData.GetPixel(xx,yy);
 image1.Bitmap.Unmap(vBitMapData);
 Memo1.Lines.Add('======================');
 memo1.Lines.Add(' Colour=' + IntToStr(pixelcolor)
                  + ' Red='    + IntToStr (TAlphaColorRec(PixelColor).R) // red
                  + ' Green='  + IntToStr (TAlphaColorRec(PixelColor).G) // blue
                  + ' Blue='   + IntToStr (TAlphaColorRec(PixelColor).B) // green
                  )  ;
end;
end.

[tintin62]

bonsoir
viens de constater que si je met un BMP
sa marche

Code :

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

1
2
 
filen:='carte500.bmp';

[SergioMaster]

Bonjour,

je ne garanti pas à 100% le code correspondant à ta demande

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
unit PixelUnit;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Edit, FMX.Controls.Presentation, FMX.Objects, FMX.Colors, FMX.Surfaces,
  FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, System.UIConsts;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Edit1: TEdit;
    EllipsesEditButton1: TEllipsesEditButton;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    procedure EllipsesEditButton1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
        TShiftState; X, Y: Single);
  private
    { Déclarations privées }
       dbmp: tbitmapdata;
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.fmx}
 
procedure TForm1.EllipsesEditButton1Click(Sender: TObject);
begin
if opendialog1.Execute then
 begin
   Edit1.Text:= opendialog1.FileName;
   Image1.Bitmap.LoadFromFile(opendialog1.FileName);
   Image1.Bitmap.Unmap(dbmp);
   image1.Bitmap.Map(TMapAccess.read,dbmp);
 end;
end;
 
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Single);
begin
  var color := dbmp.GetPixel(Trunc(X),Trunc(Y));
  memo1.lines.add('X: '+floattostr(X)+' Y: '+floattostr(Y)+' '+AlphaColorToString(Color));
 
end;

il faudrait que j'y ajoute une sorte de contrôle visuel

j'ai donc ajouté un TcolorBox et le code suivant après l'obtention de la couleur colorbox1.Color:=color;Résultat d'un test : mitigé je me doute qu'un histoire d'échelle (ou autre chose) se cache quelque-part

[tintin62]

bonjour et merci
sa marche mais faut mettre
image1.wrapmode a original
merci

[SergioMaster]

sa marche mais faut mettre
image1.wrapmode a original

Je l'ai fait mais malgré tout j'ai un doute car les résultats de mes tests ne sont pas exceptionnels. AMHA il y a un truc

[_alx_]

]

Résultat d'un test : mitigé je me doute qu'un histoire d'échelle (ou autre chose) se cache quelque-part

Bonjour,
Si je comprends bien, il s'agit d'assurer la correspondance entre le pixel écran obtenu avec la souris et les coordonnées x,y (ligne/colonne) dans l'image, puisque la couleur du pixel (TAlphaColorRec) est directement obtenue par la fonction TBitmapData.GetPixel(x, y).
Avec FMX, afin de gérer le facteur d'échelle, j'utilise un TImageViewer pour visualiser l'image au lieu d'un simple TImage.
Ce composant possède les propriétés scale et ViewPortPosition qui permettent de le faire proprement:

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
 
procedure TForm46.ImageViewer1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Single);
begin
  var V := Sender as TImageViewer;   //image fenêtrée, zoomée
  var bmp := V.Bitmap;               //image originale
  var scale := V.BitmapScale;        //facteur de zoom
  var xy := TPointF.Create(0, 0);    //coordonnées du pixel dans l'image
//calcul des coordonnées du pixel dans l'image originale
//si l'image originale est plus petite que la fenêtre, les coordonnées sont
//rapportées à leurs centres respectifs.
//si elle est plus grande (il faut alors autoriser le "scrolling" pour explorer
//la totalité de l'image), leur décalage relatf est fourni par le paramètre
//"ViewPortPosition" du composant.
  if (V.Width > (bmp.Width*scale))   //image plus petite que la fenêtre ?
    then xy.X := bmp.Width/2 + (X - V.Width/2)/scale
    else xy.X := (X + V.ViewportPosition.X)/scale;
  xy.X := EnsureRange(xy.X, 0, bmp.Width-1);
  if (V.Height > (bmp.Height*scale))
    then xy.Y := bmp.Height/2 + (Y - V.Height/2)/scale
    else xy.Y := (Y + V.ViewportPosition.Y)/scale;
  xy.Y := EnsureRange(xy.Y, 0, bmp.Height-1);
//contrôle du résultat
  Label3.Text := Format('%8.4f   %.0f,%.0f   (%.0f,%.0f  <->  %.0f,%.0f)',
    [scale, V.ViewportPosition.X, V.ViewportPosition.Y, X, Y, xy.X, xy.Y]);
end;

[tintin62]

Bonsoir et merci encore
voici un peu mes modifs
on voit clairement qu'on as pas les mêmes points
c'est pour cela que j'avais pas les mêmes couleurs

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
 
unit Unit1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,system.Math,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.ExtCtrls,
  FMX.Memo.Types, FMX.ScrollBox, FMX.Memo,system.UIConsts;
 
type
  TForm1 = class(TForm)
    ImageViewer1: TImageViewer;
    Label1: TLabel;
    Memo1: TMemo;
    procedure ImageViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Single);
    procedure ImageViewer1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
    dbmp: tbitmapdata;
 
  end;
 
var
  Form1: TForm1;
  posi:tpoint;
implementation
 
{$R *.fmx}
 
procedure TForm1.ImageViewer1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
memo1.Lines.Clear;
form1.ImageViewer1.Bitmap.Map(TMapAccess.read,dbmp);
var color := dbmp.GetPixel(posi.X,posi.Y);
form1.ImageViewer1.Bitmap.Unmap(dbmp);
memo1.lines.add('X: '+floattostr(X)+' Y: '+floattostr(Y)+' '+AlphaColorToString(Color));
end;
 
procedure TForm1.ImageViewer1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
 
begin
  var V := Sender as TImageViewer;   //image fenêtrée, zoomée
  var bmp := V.Bitmap;               //image originale
  var scale := V.BitmapScale;        //facteur de zoom
  var xy := TPointF.Create(0, 0);    //coordonnées du pixel dans l'image
//calcul des coordonnées du pixel dans l'image originale
//si l'image originale est plus petite que la fenêtre, les coordonnées sont
//rapportées à leurs centres respectifs.
//si elle est plus grande (il faut alors autoriser le "scrolling" pour explorer
//la totalité de l'image), leur décalage relatf est fourni par le paramètre
//"ViewPortPosition" du composant.
  if (V.Width > (bmp.Width*scale))   //image plus petite que la fenêtre ?
    then xy.X := bmp.Width/2 + (X - V.Width/2)/scale
    else xy.X := (X + V.ViewportPosition.X)/scale;
  xy.X := EnsureRange(xy.X, 0, bmp.Width-1);
  if (V.Height > (bmp.Height*scale))
    then xy.Y := bmp.Height/2 + (Y - V.Height/2)/scale
    else xy.Y := (Y + V.ViewportPosition.Y)/scale;
  xy.Y := EnsureRange(xy.Y, 0, bmp.Height-1);
//contrôle du résultat
  Label1.Text := Format('%8.4f   %.0f,%.0f   (%.0f,%.0f  <->  %.0f,%.0f)',
    [scale, V.ViewportPosition.X, V.ViewportPosition.Y, X, Y, xy.X, xy.Y]);
   posi.X:=round(xy.X);
   posi.y:=round(xy.y);
 
end;
 
end.

[SergioMaster]

j'utilise un TImageViewer pour visualiser l'image au lieu d'un simple TImage.

J'y pensais justement ce matin avant d'ouvrir mon PC.

Partant de la demande de départ : le TImage je me demande, par curiosité, s'il n'y aurait pas moyen de faire quelque chose.

Réponse d'une IA hier (GitHub Copilot via KAI) :

C'est déjà fait dans votre code ! 🎯

Regardez dans **PixelUnit.pas** :

```pascal
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Single);
begin
var color := dbmp.GetPixel(Trunc(x),Trunc(y)); // ← Récupère la couleur
memo1.lines.add('X: '+floattostr(X)+' Y: '+floattostr(Y)+' '+AlphaColorToString(Color));
colorbox1.Color:=color; // ← Affiche la couleur
end;
```

## Comment ça fonctionne :

1. **`dbmp.GetPixel(Trunc(x), Trunc(y))`** → récupère la couleur du pixel aux coordonnées (x, y)
2. **`dbmp`** doit être **mappé** en lecture avant (déjà fait dans `EllipsesEditButton1Click`) :
```pascal
image1.Bitmap.Map(TMapAccess.read, dbmp);
```

3. **`AlphaColorToString(color)`** → convertit la couleur en texte

## Si vous voulez en temps réel (pas juste au clic) :

```pascal
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
if dbmp.Width > 0 then // Vérifie que le bitmap est chargé
begin
var color := dbmp.GetPixel(Trunc(x), Trunc(y));
Label1.Text := AlphaColorToString(color);
ColorBox1.Color := color;
end;
end;
```

Besoin d'aide pour l'implémenter ?

Moi : Non pas d'aide m'ai j'obtiens des résultats faux

Le problème vient probablement du **redimensionnement du TImage** !

En FMX, quand on affiche une image dans un TImage, elle peut être zoomée/réduite. Les coordonnées de la souris doivent être ajustées :

```pascal
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
TShiftState; X, Y: Single);
var
AdjustedX, AdjustedY: Single;
begin
// Convertir les coordonnées du contrôle vers le bitmap
AdjustedX := (X / Image1.Width) * Image1.Bitmap.Width;
AdjustedY := (Y / Image1.Height) * Image1.Bitmap.Height;

var color := dbmp.GetPixel(Trunc(AdjustedX), Trunc(AdjustedY));
memo1.lines.add('X: '+floattostr(AdjustedX)+' Y: '+floattostr(AdjustedY)+' '+AlphaColorToString(Color));
colorbox1.Color := color;
end;
```

**Ça fait quoi ?** Ramène les coordonnées de la taille du TImage à la taille réelle du bitmap.

Essayez ça et testez. Ça devrait corriger les faux résultats !

Je vous épargne la suite de la discussion me demandant des précisions qui m'ont finalement plus ou moins mis sur la piste.

En fait, en mutilpliant les coordonnées par 1.25 j'ai les bons résultats.

Comment j'en suis arrivé à 1.25 c'est la bonne question
Dans les diverses demandes d'informations j'ai extrait ceci

Image1.bitmap width=612 height =342
Image1.bitmap BytesPerPixel =4 PixelFormat=BGRA
dbmp width=612 height =342
dbmp bytesperpixel=4 PixelFormat=BGRA
dbmp Scanline=2448 Pitch=2448

c'est le BytesPerPixel qui m'a mis sur la piste : 1/4 = 0.25. Cependant cette valeur n'est que l'indication.

En fait je me cite :

je me doute qu'un histoire d'échelle se cache quelque-part

J'avais raison, restait à obtenir cette fameuse échelle ce que j'ai obtenu en utilisant ce code (Delphi 13.1)

Code :

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

scale:=Screen.DisplayFromForm(Self).Scale;

Ceci n'est bien évidemment qu'un premier jus permettant l'obtention de l'échelle (cette fameuse constante 1.25). Avantage : sans tester, je pense que cela fonctionnerait en cas de multi-écran (pas envie de tester)

Reste, pour moi, un point noir : l'obligation de mettre image1.wrapmode = original d'autres calculs devraient en avoir raison

[SergioMaster]

Autre manière d'obtenir l'échelle nettement plus simple, sans tenir compte des écrans putatifs : Timage.Bitmap a la propriété BitmapScale (comme quoi il faut toujours chercher dans les sources)

donc ce code fonctionne

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
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
    Single);
var
  AdjustedX, AdjustedY: Single;
begin
mouseposlabel.Text:=format('X=%d Y=%d',[trunc(X),trunc(Y)]);
if   (x>=0) AND (x<=dbmp.width)
 AND (y>=0) AND (y<=dbmp.height)
 then begin
      AdjustedX := X*Image1.Bitmap.Scale;
      AdjustedY := y*Image1.Bitmap.Scale; 
      var color := dbmp.GetPixel(Trunc(X),Trunc(Y));
      colorbox1.Color:=color;
 end;
end;

Je vais désormais introduire, toujours par curiosité, un autre paramètre : le wrapmode pour obtenir quelque chose de moins "contraignant" que le seul mode Original.
Voilà déjà une premiere vérification (écrite hier) pour obtenir les marges de l'image affichée

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 TForm1.ComboBox1Change(Sender: TObject);
var
  ImageDisplayWidth, ImageDisplayHeight: Single;
  MarginLeft, MarginTop: Single;
 
begin
//
image1.WrapMode:=TImageWrapMode(combobox1.ItemIndex);
Memo1.Lines.Add('WrapMode: '+combobox1.Items[combobox1.ItemIndex]);
Memo1.Lines.Add('Image Width: '+image1.Width.ToString+' Height: '+image1.Height.ToString);
Memo1.Lines.Add('Image Bitmap Width: '+image1.Bitmap.Width.ToString+' Height: '+image1.Bitmap.Height.ToString);
Memo1.Lines.Add('Image Bitmap Scale  : '+image1.Bitmap.Image.BitmapScale.ToString);
Memo1.Lines.Add('Image WrapMode : ');
 
  case Image1.WrapMode of
 
    TImageWrapmode.Original:
      begin
        MarginLeft := 0;
        MarginTop := 0;
      end;
 
    TImageWrapMode.Center, TImageWrapMode.Place:
      begin
        ImageDisplayWidth := Image1.Bitmap.Width *
          Image1.Bitmap.Image.BitmapScale;
        ImageDisplayHeight := Image1.Bitmap.Height *
          Image1.Bitmap.Image.BitmapScale;
        MarginLeft := (Image1.Width - ImageDisplayWidth) / 2;
        MarginTop := (Image1.Height - ImageDisplayHeight) / 2;
        Memo1.Lines.Add(Format('Center - Marges Left/Right: %.0f | Top/Bottom: %.0f',
            [MarginLeft, MarginTop]));
      end;
 
    TImageWrapMode.Fit:
      begin
        var AspectRatioBitmap := Image1.Bitmap.Width / Image1.Bitmap.Height;
        var AspectRatioControl := Image1.Width / Image1.Height;
 
        if AspectRatioBitmap > AspectRatioControl then
        begin
          ImageDisplayWidth := Image1.Width;
          ImageDisplayHeight := Image1.Width / AspectRatioBitmap;
        end
        else
        begin
          ImageDisplayHeight := Image1.Height;
          ImageDisplayWidth := Image1.Height * AspectRatioBitmap;
        end;
 
        MarginLeft := (Image1.Width - ImageDisplayWidth) / 2;
        MarginTop := (Image1.Height - ImageDisplayHeight) / 2;
        Memo1.Lines.Add(Format('Fit - Marges Left/Right: %.0f | Top/Bottom: %.0f',
            [MarginLeft, MarginTop]));
      end;
  end;

me reste encore les modes Stretch et Tile.
J'ai également un doute sur Place, est-ce vraiment identique à Center (toutes les images que j'ai testées semble le prouver )?
les commentaires

/// <summary> Display the image with its original dimensions. </summary>
Original,
/// <summary> Stretches image into the LocalRect, preserving aspect ratio. When LocalRect
/// is bigger than image, the last one will be stretched to fill LocalRect </summary>
Fit,
/// <summary> Stretch the image to fill the entire control's rectangle.</summary>
Stretch,
/// <summary> Tile (multiply) the image to cover the entire control's rectangle. </summary>
Tile,
/// <summary> Center the image to the control's rectangle. </summary>
Center,
/// <summary> Places the image inside the LocalRect. If the image is greater
/// than the LocalRect then the source rectangle is scaled with aspect ratio.
/// </summary>
Place

sont moins affirmatifs. Déjà ce LocalRect qui vient se mettre dans la danse en rajoute une couche.

[ShaiLeTroll]

Cela ressemble beaucoup au sujet "image dans un TImageviewer et pouvoir adresser les pixels à l'aide la souris".