grabbing the colour of a pixel from the coordinates of the pixel in a bitmap or

[John_Nicol]

I want to be able to provide the pixel coordinates in a picture and obtain a numerical or string definition of the colour represented by that pixel.  Can someone provide a clear, simple code which will run in Lazrus Free Pascal? Thank you.
John Nicol

[Handoko]

Hello John_Nicol,
Welcome to the forum.

I wrote a simple example, it should be easy to understand. You can download the test.zip. Next time, please do not do double post.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLType;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Image1: TImage;
17.     Label1: TLabel;
18.     OpenDialog1: TOpenDialog;
19.     Shape1: TShape;
20.     procedure Button1Click(Sender: TObject);
21.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
22.       );
23.   private
24.     { private declarations }
25.   public
26.     { public declarations }
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.  
32. implementation
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.Button1Click(Sender: TObject);
39. var
40.   AJpg:  TJPEGImage;
41. begin
42.   if not(OpenDialog1.Execute) then Exit;
43.   AJpg := TJpegImage.Create;
44.   AJpg.LoadFromFile(OpenDialog1.FileName);
45.   Image1.Picture.Bitmap.Assign(AJpg);
46.   AJpg.Free;
47.   Image1.Enabled := True;
48. end;
49.  
50. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
51.   Y: Integer);
52. var
53.   ScanData: PRGBQuad;
54.   ValR, ValG, ValB: Byte;
55. begin
56.   // Point to the pixel location
57.   ScanData := Image1.Picture.Bitmap.ScanLine[Y];
58.   Inc(ScanData, X);
59.   // Get RGB value of the pixel
60.   ValR := ScanData^.rgbRed;
61.   ValG := ScanData^.rgbGreen;
62.   ValB := ScanData^.rgbBlue;
63.   // Show information of the pixel
64.   Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
65.   Label1.Caption := 'x'+IntToStr(X)+':y'+IntToStr(Y)+' = r'+
66.     IntToStr(ValR)+', g'+IntToStr(ValG)+', b'+IntToStr(ValB);
67. end;
68.  
69. end.

[Ñuño_Martínez]

Please don't duplicate your threads. It doesn't help to have more ansers (as you see) but fills the forums with shitty stuff.

Thanks.

[Handoko]

@John_Nicol

I have improved the code, it now supports *.bmp files. It worked on my Linux tests, it should work on Windows too.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLType;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Image1: TImage;
17.     Label1: TLabel;
18.     OpenDialog1: TOpenDialog;
19.     Shape1: TShape;
20.     procedure Button1Click(Sender: TObject);
21.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
22.       );
23.   private
24.     procedure LoadJPEG;
25.     procedure LoadBMP;
26.   end;
27.  
28. var
29.   Form1: TForm1;
30.  
31. implementation
32.  
33. {$R *.lfm}
34.  
35. { TForm1 }
36.  
37.  
38.  
39. procedure TForm1.Button1Click(Sender: TObject);
40. var
41.   FileExt: string;
42. begin
43.   if not(OpenDialog1.Execute) then Exit;
44.   FileExt := LowerCase(ExtractFileExt(OpenDialog1.FileName));
45.   if (FileExt = '.jpg') or (FileExt = '.jpeg') or (FileExt = '.jpe') then
46.     LoadJPEG
47.   else
48.     if (FileExt = '.bmp') then
49.       LoadBMP;
50. end;
51.  
52. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
53.   Y: Integer);
54. var
55.   ScanData: PRGBQuad;
56.   ValR, ValG, ValB: Byte;
57. begin
58.   // Point to the pixel location
59.   ScanData := Image1.Picture.Bitmap.ScanLine[Y];
60.   Inc(ScanData, X);
61.   // Get RGB value of the pixel
62.   ValR := ScanData^.rgbRed;
63.   ValG := ScanData^.rgbGreen;
64.   ValB := ScanData^.rgbBlue;
65.   // Show information of the pixel
66.   Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
67.   Label1.Caption := 'x'+IntToStr(X)+':y'+IntToStr(Y)+' = r'+
68.     IntToStr(ValR)+', g'+IntToStr(ValG)+', b'+IntToStr(ValB);
69. end;
70.  
71. procedure TForm1.LoadJPEG;
72. var
73.   AJpg:  TJPEGImage;
74. begin
75.   AJpg := TJpegImage.Create;
76.   AJpg.LoadFromFile(OpenDialog1.FileName);
77.   Image1.Picture.Bitmap.Assign(AJpg);
78.   AJpg.Free;
79.   Image1.Enabled := True;
80. end;
81.  
82. procedure TForm1.LoadBMP;
83. var
84.   ABmp:  TBitmap;
85. begin
86.   ABmp := TBitmap.Create;
87.   ABmp.LoadFromFile(OpenDialog1.FileName);
88.   Image1.Picture.Bitmap.Assign(ABmp);
89.   ABmp.Free;
90.   Image1.Enabled := True;
91. end;
92.  
93. end.

[John_Nicol]

I appreciate your continued help but the new code provides me with the same problem of producing a runtime error of SIG... at the first statement which accesses a pixel and asks for the color code.- "ValR := ScanData^.rgbRed" What other code do I need.  I run the procedures in a sequence of loading the bitmap file and then running the procedure which I expect will provide the colours of the prescribed pixel.  Is this what I should be doing?  Do I need to supply some specific values for X and Y?  This is not clear to me as I am only now trying to get to grips with this graphics stuff.

Essentially what I want to do is to be able to load up either a bitmap, Jpeg, Png or whatever and determine the colour of each defined pixel on that picture.  within the limits of its coordinates.  I would have thought that giving values to X and Y wpould have defined a pixel and that VALR would hold the code for the depth of red in the pixel at that coordinate.  Is that not so?

I am writing this to let you know what my level of ignorance is.  Running the procedures you have given me after including the lines in the programme's controls at the top, does not seem to provide a result even though the code compiles quite happily.  Any further help would be appreciated. ;

[John_Nicol]

Perhaps it is a problem inWindows which is absent in Linux!

[Handoko]

I'm not on my pc now. I'll try to get my old Win laptop and solve this issue. Please be patient. Give me some hours.

[taazz]

Perhaps it is a problem inWindows which is absent in Linux!

you are writing a win32 or win64 application?
you use the default win32 widgetset or you have set it to use something else (Eg QT)? After 2 working examples you should be able to make it work in this case create a small sample application showing the problem and we will identify the problem for you. To be absolutely clear, opening the supplied test project from lazarus 1.6.4 and pressing run simply works, after I open an image, I move the mouse over the image, and it  shows me the rgb values of the pixel behind it. I might have added the x,y coordinates as well but everything you need to know is there. So I'd rather see something from you that doesn't work and see if we can find what wend wrong.

[molly]

Pretty wierd results from that code. Try the fpcmeetssdl logo here and see the RGB values changing when you hover the mouse over the blue pixels.

There is also a warning: scanline is not portable across platforms. So, just get rid of that scanline all together and use canvas pixels:

Code: [Select]

var
  ValR2, ValG2, ValB2: Byte;
  PixelColor : TColor;
...
  PixelColor := Image1.Picture.Bitmap.Canvas.Pixels[x,y];
  valR2 := GetRValue(PixelColor);
  valG2 := GetGValue(PixelColor);
  valB2 := GetBValue(PixelColor);
...

Don't forget to include unit LCLIntf for GetXXXValue functions though.

[Handoko]

I guess I know why. I heard some images have (non standard) pixel formats. I personally have not found such images, so I thought my code will always work. If this is the cause, then PRGBQuad is not suitable for the image. You can try to search the web using keyword "bitmap pixel format".

The SIGSEG (or similar) errors may happen if we are trying to read data outside the data location. It is possible to happen on my code, if the pixel format is 3 bytes while PRGBQuad is 4 bytes.

I am busy now, any volunteers please help improve the code.

[Handoko]

-edited on 17th August 2023-
An improved version that supports PNG files can be downloaded here:
https://forum.lazarus.freepascal.org/index.php/topic,37242.msg488758.html#msg488758




---- original post ----

Now I has improved the code, but PNG files and some pixel formats are still not supported:
✓ JPEG
✓ BMP
✗ PNG
✓ pf24bit
✓ pf32bit
✗ pdDevice
✗ pf1bit
✗ pf4bit
✗ pf15bit
✗ pf16bit
✗ pfCustom

The common used pixel formats are pf24bit and pf32bit. If I am not wrong, JPEG always uses pf32bit pixel format (var R, G, B, reserved: Byte). Bitmap *.bmp can use varies of pixel formats, my code only supports pf24bit and fp32bit. If you need to support more pixel formats, you can do research how the data stored for different pixel formats and add it to the code.

Bitmap can support transparency (alpha channel), except for pf24bit. Although JPEG uses 32-bit data per pixel (8-bit per channel), the fourth channel is reserved.

To learn more about pixel format:
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Graphics_TPixelFormat.html

This is the code of test3.zip:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLType;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Image1: TImage;
17.     lblPixelFormat: TLabel;
18.     lblInfo: TLabel;
19.     OpenDialog1: TOpenDialog;
20.     Shape1: TShape;
21.     procedure Button1Click(Sender: TObject);
22.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
23.       );
24.   private
25.     LoadedPixelFormat: TPixelFormat;
26.     procedure LoadJPEG;
27.     procedure LoadBMP;
28.     procedure GetRGB(X, Y: Integer; out R, G, B: Byte; out Alpha: string);
29.   end;
30.  
31. var
32.   Form1: TForm1;
33.  
34. implementation
35.  
36. {$R *.lfm}
37.  
38. { TForm1 }
39.  
40. procedure TForm1.Button1Click(Sender: TObject);
41. var
42.   FileExt: string;
43. begin
44.  
45.   if not(OpenDialog1.Execute) then Exit;
46.  
47.   Image1.Enabled := True;
48.   lblPixelFormat.Visible := True;
49.   lblInfo.Visible := True;
50.  
51.   // Open the file
52.   FileExt := LowerCase(ExtractFileExt(OpenDialog1.FileName));
53.   if (FileExt = '.jpg') or (FileExt = '.jpeg') or (FileExt = '.jpe') then
54.     LoadJPEG
55.   else
56.     if (FileExt = '.bmp') then
57.       LoadBMP;
58.  
59.   // Show Pixel Format info
60.   case LoadedPixelFormat of
61.     pfDevice:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Device';
62.     pf1bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'1-bit';
63.     pf4bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'4-bit';
64.     pf8bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'8-bit';
65.     pf15bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'15-bit';
66.     pf16bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'16-bit';
67.     pf24bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'24-bit';
68.     pf32bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'32-bit';
69.     pfCustom:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Custom';
70.   end;
71.  
72.   // Clear previous info
73.   Shape1.Brush.Color := clBackground;
74.   lblInfo.Caption := '';
75.  
76. end;
77.  
78. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
79.   Y: Integer);
80. var
81.   ValR, ValG, ValB: Byte;
82.   Alpha: string;
83. begin
84.   if (LoadedPixelFormat = pf24bit) or (LoadedPixelFormat = pf32bit) then
85.   begin
86.     GetRGB(X, Y, ValR, ValG,ValB, Alpha);
87.     Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
88.     lblInfo.Caption :=
89.       'X = '+IntToStr(X)+    #13+
90.       'Y = '+IntToStr(Y)+    #13+
91.       'R = '+IntToStr(ValR)+ #13+
92.       'G = '+IntToStr(ValG)+ #13+
93.       'B = '+IntToStr(ValB)+ #13+
94.       Alpha;
95.   end;
96. end;
97.  
98. procedure TForm1.LoadJPEG;
99. var
100.   AJpg:  TJPEGImage;
101. begin
102.   AJpg := TJpegImage.Create;
103.   AJpg.LoadFromFile(OpenDialog1.FileName);
104.   Image1.Picture.Bitmap.Assign(AJpg);
105.   AJpg.Free;
106.   LoadedPixelFormat := pf32bit;
107. end;
108.  
109. procedure TForm1.LoadBMP;
110. var
111.   ABmp:  TBitmap;
112. begin
113.   ABmp := TBitmap.Create;
114.   ABmp.LoadFromFile(OpenDialog1.FileName);
115.   Image1.Picture.Bitmap.Assign(ABmp);
116.   ABmp.Free;
117.   LoadedPixelFormat := Image1.Picture.Bitmap.PixelFormat;
118. end;
119.  
120. procedure TForm1.GetRGB(X, Y: Integer; out R, G, B: Byte; out Alpha: string);
121. var
122.   ScanData:  Pointer;
123.   Data24bit: PRGBTriple absolute ScanData;
124.   Data32bit: PRGBQuad   absolute ScanData;
125. begin
126.   ScanData := Image1.Picture.Bitmap.ScanLine[Y];
127.   case LoadedPixelFormat of
128.     pf24bit:
129.       begin
130.         Inc(ScanData, X * 3);
131.         R := Data24bit^.rgbtRed;
132.         G := Data24bit^.rgbtGreen;
133.         B := Data24bit^.rgbtBlue;
134.         Alpha := '';
135.       end;
136.     pf32bit:
137.       begin
138.         Inc(ScanData, X * 4);
139.         R := Data32bit^.rgbRed;
140.         G := Data32bit^.rgbGreen;
141.         B := Data32bit^.rgbBlue;
142.         Alpha := 'A = ' + IntToStr(Data32bit^.rgbReserved);
143.       end;
144.   end;
145. end;
146.  
147. end.

I appreciate your continued help but the new code provides me with the same problem of producing a runtime error of SIG...

The problem should be solved now. It happened because my previous code used PRGBQuad to read data of pf24bit, which is very wrong. My fault.

Pretty wierd results from that code. Try the fpcmeetssdl logo here and see the RGB values changing when you hover the mouse over the blue pixels.

This issue should be solved now too. That image is 24-bit, which was not supported by my previous code.

[John_Nicol]

  :)Thank you very much indeed Handoko.  I appreciate very much your persistence with this problem on my behalf.  I haven't downloaded the code yet but will let you know when I have done that.  Thanks again  John Nicol

[User137]

There's 1 other way:

Code: Pascal  [Select][+][-]

1. uses ... , FPImage; // Add
2. ...
3.  
4. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
5. var c: TFPColor;
6. begin
7.   c:=image1.Picture.Bitmap.Canvas.Colors[X, Y];
8.   // TFPColor has RGBA each channel in 0..65535 format
9.   caption:=format('%d, %d, %d, %d',
10.     [c.red div 256, c.green div 256, c.blue div 256, c.alpha div 256]);
11.   // In current test with transparent PNG it reported colors correctly but alpha always 255.
12. end;

But it's very simple code, should work with all formats and crossplatform.

[Handoko]

Thanks User137 for suggesting FPImage.

I tested it on some images I created using GIMP, FPImage supports:
✓ JPEG
✓ BMP pf16bit  ✗ but failed to detect alpha value
✓ BMP pf24bit
✓ BMP pf32bit  ✗ but failed to detect alpha value

My GetRGB code doesn't support pf16bit images but it can detect alpha value of pf32bit images properly. The image below is the comparison using FPImage (result shows on the title bar) and my GetRGB function on a pf32bit image that contains alpha channel. You can see the mouse pointer is on the blue pixel with alpha = 34.

FPImage result:     0, 144, 255, 255
The correct result: 0, 144, 255, 34

[molly]

A couple of remarks (nitpicking perhaps but i hope you can forgive me for that):

1) Make sure to map TImage correctly to your picture:

Although a TImage component can be used to "map" it's own canvas pixels (read: coordinates) to underlying bitmap, this can be only done when TImage's width and height and location corresponds to dimensions of (loaded) picture/bitmap that is being interrogated for its pixels.

That means that in order for this to work accurately, you would need to set the autosize property of the TImage to true.

Doing so has some implications.

Notably the left top corner and the image spawning over your other controls because width and height are too big for current form
dimensions and TImage tries to fit things inside your form.

The former can be fixed by setting anchors to custom, using left top anchors and the latter can be fixed by setting width and height constraints to something comfortable (such as current designed width and height).

Really take note of this point, because when you do not do this then results get pretty weird (e.g. showing color information when there actually is not a visible pixel for user/TImage) because the loaded image tries to 'fit' on your form when not taking this into account. This shows when you load different pictures of different dimensions, notably a loading a big picture, followed by smaller picture (or vice versa).

Of course, using stretched and centered for the TImage is out of the question when trying to map, unless you know the underlying used techniques (so you can replicate). I've tried to play with it, but it is plain confusing because TBitmap pictures don't seem to follow the same rules that all other picture types seem to follow.


2) Make LCL do the hard work for loading a picture:

Freepascal/LCL has a fairly good dialog specially crafted for opening images. It is named TOpenPictureDialog (nitpicking, i know, but still. See also next point)


3) TImage is already capable of loading "other" fileformats. Quite a lot actually.

Use TImage's Picture.LoadFromFile method, and use TOpenPictureDialog's filename property for the filename.


4) Additional information

While we're at it, why not display some more information from the Picture/Image to user, using hints.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Graphics, Dialogs, StdCtrls, ExtCtrls, LCLType,
9.   ExtDlgs;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     Button1: TButton;
17.     Image1: TImage;
18.     lblPixelFormat: TLabel;
19.     lblInfo: TLabel;
20.     OpenPictureDialog1: TOpenPictureDialog;
21.     Shape1: TShape;
22.     procedure FormCreate(Sender: TObject);
23.     procedure Button1Click(Sender: TObject);
24.     procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
25.       );
26.   private
27.     LoadedPixelFormat: TPixelFormat;
28.     procedure GetRGBA(X, Y: Integer; out R, G, B, A: Byte);
29.   end;
30.  
31. var
32.   Form1: TForm1;
33.  
34. implementation
35.  
36. {$R *.lfm}
37.  
38. uses
39.   TypInfo, FPImage, Controls;
40.  
41. { TForm1 }
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. begin
45.   // Point 1: Make sure TImage 'maps' correctly to the loaded picture coordinates.
46.   Image1.Align := alCustom;
47.   Image1.Anchors := [akTop, akLeft];
48.   Image1.Constraints.MaxHeight := Image1.Height;
49.   Image1.Constraints.MaxWidth := Image1.Width;
50.   Image1.AutoSize := True;
51.  
52.   // Point 4: Additonal information
53.   Image1.ShowHint  := true;
54.   lblPixelFormat.ShowHint := true;
55. end;
56.  
57.  
58. procedure TForm1.Button1Click(Sender: TObject);
59. var
60.   FileExt: string;
61. begin
62.   // Point 2: using OpenPictureDialog
63.   if not(OpenPictureDialog1.Execute) then Exit;
64.  
65.   Image1.Enabled := True;
66.   lblPixelFormat.Visible := True;
67.   lblInfo.Visible := True;
68.  
69.   // Open the file
70.   // Point 3: let TImage do all the hard work for us.
71.   Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
72.  
73.   // Inspect the pixelformat
74.   LoadedPixelFormat := (Image1.Picture.Graphic as TRasterImage).PixelFormat;
75.  
76.   // Show Pixel Format info
77.   case LoadedPixelFormat of
78.     pfDevice:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Device';
79.     pf1bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'1-bit';
80.     pf4bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'4-bit';
81.     pf8bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'8-bit';
82.     pf15bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'15-bit';
83.     pf16bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'16-bit';
84.     pf24bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'24-bit';
85.     pf32bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'32-bit';
86.     pfCustom:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Custom';
87.   end;
88.  
89.   // Clear previous info
90.   Shape1.Brush.Color := clBackground;
91.   lblInfo.Caption := '';
92.  
93.   // Point 4: some extra information for TImage and Loaded picture
94.   Image1.Hint:= Format
95.   (
96.     'TImage information : ' + sLineBreak + sLineBreak +
97.     'Left,Top'      + ': %d,%d' + sLineBreak +
98.     'Width,Height'  + ': %d,%d' + sLineBreak +
99.     'AutoSize'      + ': %s' + sLineBreak +
100.     'Center'        + ': %s' + sLineBreak +
101.     'Proportional'  + ': %s' + sLineBreak +
102.     'Stretch'       + ': %s' + sLineBreak +
103.     'Transparent'   + ': %s'
104.     ,
105.     [
106.       Image1.Left, Image1.Top,
107.       Image1.Width, Image1.Height,
108.       BoolToStr(Image1.AutoSize    , 'On', 'Off'),
109.       BoolToStr(Image1.Center      , 'On', 'Off'),
110.       BoolToStr(Image1.Proportional, 'On', 'Off'),
111.       BoolToStr(Image1.Stretch     , 'On', 'Off'),
112.       BoolToStr(Image1.Transparent , 'On', 'Off')
113.     ]
114.   );
115.  
116.   lblPixelFormat.Hint := Format
117.   (
118.     'TPicture information:' + sLineBreak + sLineBreak +
119.     'ClassName'        + ': %s'  + sLineBreak +
120.     'MimeType'         + ': %s'  + sLineBreak +
121.     'PixelFormat'      + ': %s'  + sLineBreak +
122.     'TransparentMode'  + ': %s'  + sLineBreak +
123.     'Transparent'      + ': %s'  + sLineBreak +
124.     'TransparentColor' + ': $%X' + sLineBreak +
125.     'Masked'           + ': %s'
126.     ,
127.     [
128.       Image1.Picture.Graphic.ClassName,
129.       Image1.Picture.Graphic.MimeType,
130.       GetEnumName(TypeInfo(TPixelFormat), Ord((Image1.Picture.Graphic as TRasterImage).PixelFormat)),
131.       GetEnumName(TypeInfo(TTransparentMode), Ord((Image1.Picture.Graphic as TRasterImage).TransparentMode)),
132.       BoolToStr(Image1.Picture.Graphic.Transparent, 'Yes', 'No'),
133.       (Image1.Picture.Graphic as TRasterImage).TransparentColor,
134.       BoolToStr((Image1.Picture.Graphic as TRasterImage).Masked, 'Yes', 'No')
135.     ]
136.   );
137. end;
138.  
139.  
140. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
141.   Y: Integer);
142. var
143.   Alpha: string;
144.   ValR, ValG, ValB, ValA : Byte;
145. begin
146.   GetRGBA(X, Y, ValR, ValG, valB, ValA);
147.  
148.   // These are the only pixelformats i'm familiar with that _could_
149.   // contain alpha. Other pixelformats are indexed (using a palette) or are
150.   // (afaik) not applicable (e.g. pfDevice/pfCustom).
151.   // Seeing how LCL handles things, only 32-bit pictures _can_ use active
152.   // alpha.
153.   // (note how LCL loads all non bmp data as either 24 or 32 bit, at least on
154.   // Windows platform).
155.   if LoadedPixelFormat in [pf15bit, pf16bit, pf32bit] then
156.   begin
157.     case LoadedPixelFormat of
158.       pf15bit : Alpha := 'A = <unknown15> - Send us the picture';
159.       pf16bit : Alpha := 'A = <unknown16> - Send us the picture';
160.       pf32bit : WriteStr(Alpha, 'A = ', ValA);
161.     end;    
162.   end
163.   else Alpha := '';
164.  
165.   Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
166.   lblInfo.Caption :=
167.     'X = '+IntToStr(X)+    #13+
168.     'Y = '+IntToStr(Y)+    #13+
169.     'R = '+IntToStr(ValR)+ #13+
170.     'G = '+IntToStr(ValG)+ #13+
171.     'B = '+IntToStr(ValB)+ #13+
172.     Alpha;
173. end;
174.  
175.  
176. procedure TForm1.GetRGBA(X, Y: Integer; out R, G, B, A: Byte);
177. var
178.   ScanData:  Pointer;
179.   Data32bit: PRGBQuad absolute ScanData;
180.   col: TFPColor;
181. begin
182.   // Why does returned TPFcolor not contain Alpha value !?
183.   Col := (Image1.Picture.Graphic as TRasterImage).Canvas.Colors[X, Y];
184.  
185.   R := Col.red   div 256;
186.   G := Col.green div 256;
187.   B := Col.blue  div 256;
188.  
189.   with (Image1.Picture.Graphic as TRasterImage) do
190.   begin
191.     ScanData := ScanLine[Y];
192.     case LoadedPixelFormat of
193.       pf15bit :
194.         begin
195.           A := 15;
196.         end;
197.       pf16bit :
198.         begin
199.           A := 16;
200.         end;
201.       pf32bit :
202.         begin
203.           Inc(ScanData, X * 4);
204.           A := Data32bit^.rgbReserved;
205.         end;
206.       else
207.         begin
208.           A := 0;
209.         end;
210.     end;
211.   end;
212. end;
213.  
214. end.
215.