* * *

Author Topic: grabbing the colour of a pixel from the coordinates of the pixel in a bitmap or  (Read 1587 times)

John_Nicol

  • New member
  • *
  • Posts: 6
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

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
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. :D

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

  • Hero Member
  • *****
  • Posts: 630
    • Burdjia
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

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
@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

  • New member
  • *
  • Posts: 6
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

  • New member
  • *
  • Posts: 6
Perhaps it is a problem inWindows which is absent in Linux!

Handoko

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
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

  • Hero Member
  • *****
  • Posts: 4271
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.
« Last Edit: July 10, 2017, 03:21:46 pm by taazz »
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

molly

  • Hero Member
  • *****
  • Posts: 1829
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

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
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

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
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

  • New member
  • *
  • Posts: 6
 :) :)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

  • Hero Member
  • *****
  • Posts: 1717
    • Nxpascal home
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.
« Last Edit: July 17, 2017, 11:00:21 am by User137 »

Handoko

  • Hero Member
  • *****
  • Posts: 1514
  • My goal: build my own game engine using Lazarus
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
« Last Edit: July 17, 2017, 01:23:38 pm by Handoko »

molly

  • Hero Member
  • *****
  • Posts: 1829
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.  

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus