Recent

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

taazz

  • Hero Member
  • *****
  • Posts: 5368
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.
3.A the format mechanism is extendable you can use an image library that correctly supports lcl and extend your formats to anything you might need, openpicture dialog and image/picture.loadfromfile helps you code less.
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

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
@molly

Awesome, you solved some issues that I haven't solved. And you put detailed comments on the code. I will need some time to study the code.

You suggestion using hint is good but it may block the image form our sight.

I did not use Colors[X, Y] because it is very slow, ScanLine is much faster. But for simply showing the pixel information, Colors[X, Y] is okay.

The code now is very complete. The TS should have no problem writing the thing he needs. But honestly, if I want to write such function I personally will choose more powerful graphics library. Maybe BGRABitmap.

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
Now it support PNG files. Tested on Linux only.

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 LoadPNG;
  29.     procedure GetRGB(X, Y: Integer; out R, G, B: Byte; out Alpha: string);
  30.   end;
  31.  
  32. var
  33.   Form1: TForm1;
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. procedure TForm1.Button1Click(Sender: TObject);
  42. var
  43.   FileExt: string;
  44. begin
  45.  
  46.   if not(OpenDialog1.Execute) then Exit;
  47.  
  48.   Image1.Enabled := True;
  49.   lblPixelFormat.Visible := True;
  50.   lblInfo.Visible := True;
  51.  
  52.   // Open the file
  53.   FileExt := LowerCase(ExtractFileExt(OpenDialog1.FileName));
  54.   case FileExt of
  55.     '.jpg', '.jpeg', 'jpe': LoadJPEG;
  56.     '.png':                 LoadPNG;
  57.     '.bmp':                 LoadBMP;
  58.   end;
  59.  
  60.   // Show Pixel Format info
  61.   case LoadedPixelFormat of
  62.     pfDevice:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Device';
  63.     pf1bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'1-bit';
  64.     pf4bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'4-bit';
  65.     pf8bit:    lblPixelFormat.Caption := 'Pixel Format'+#13+'8-bit';
  66.     pf15bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'15-bit';
  67.     pf16bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'16-bit';
  68.     pf24bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'24-bit';
  69.     pf32bit:   lblPixelFormat.Caption := 'Pixel Format'+#13+'32-bit';
  70.     pfCustom:  lblPixelFormat.Caption := 'Pixel Format'+#13+'Custom';
  71.   end;
  72.  
  73.   // Clear previous info
  74.   Shape1.Brush.Color := clBackground;
  75.   lblInfo.Caption := '';
  76.  
  77. end;
  78.  
  79. procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  80.   Y: Integer);
  81. var
  82.   ValR, ValG, ValB: Byte;
  83.   Alpha: string;
  84. begin
  85.   if (LoadedPixelFormat = pf24bit) or (LoadedPixelFormat = pf32bit) then
  86.   begin
  87.     GetRGB(X, Y, ValR, ValG,ValB, Alpha);
  88.     Shape1.Brush.Color := RGBToColor(ValR, ValG, ValB);
  89.     lblInfo.Caption :=
  90.       'X = '+IntToStr(X)+    #13+
  91.       'Y = '+IntToStr(Y)+    #13+
  92.       'R = '+IntToStr(ValR)+ #13+
  93.       'G = '+IntToStr(ValG)+ #13+
  94.       'B = '+IntToStr(ValB)+ #13+
  95.       Alpha;
  96.   end;
  97. end;
  98.  
  99. procedure TForm1.LoadJPEG;
  100. var
  101.   AJpg:  TJPEGImage;
  102. begin
  103.   AJpg := TJpegImage.Create;
  104.   try
  105.     AJpg.LoadFromFile(OpenDialog1.FileName);
  106.     Image1.Picture.Bitmap.Assign(AJpg);
  107.   finally
  108.     AJpg.Free;
  109.   end;
  110.   LoadedPixelFormat := pf32bit;
  111. end;
  112.  
  113. procedure TForm1.LoadBMP;
  114. var
  115.   ABmp:  TBitmap;
  116. begin
  117.   ABmp := TBitmap.Create;
  118.   try
  119.     ABmp.LoadFromFile(OpenDialog1.FileName);
  120.     Image1.Picture.Bitmap.Assign(ABmp);
  121.   finally
  122.     ABmp.Free;
  123.   end;
  124.   LoadedPixelFormat := Image1.Picture.Bitmap.PixelFormat;
  125. end;
  126.  
  127. procedure TForm1.LoadPNG;
  128. var
  129.   APNG: TPortableNetworkGraphic;
  130. begin
  131.   APNG := TPortableNetworkGraphic.Create;
  132.   try
  133.     APNG.LoadFromFile(OpenDialog1.FileName);
  134.     Image1.Picture.Bitmap.Assign(APNG);
  135.   finally
  136.     APNG.Free;
  137.   end;
  138.   LoadedPixelFormat := Image1.Picture.Bitmap.PixelFormat;
  139. end;
  140.  
  141. procedure TForm1.GetRGB(X, Y: Integer; out R, G, B: Byte; out Alpha: string);
  142. var
  143.   ScanData:  Pointer;
  144.   Data24bit: PRGBTriple absolute ScanData;
  145.   Data32bit: PRGBQuad   absolute ScanData;
  146. begin
  147.   ScanData := Image1.Picture.Bitmap.ScanLine[Y];
  148.   case LoadedPixelFormat of
  149.     pf24bit:
  150.       begin
  151.         Inc(ScanData, X * 3);
  152.         R := Data24bit^.rgbtRed;
  153.         G := Data24bit^.rgbtGreen;
  154.         B := Data24bit^.rgbtBlue;
  155.         Alpha := '';
  156.       end;
  157.     pf32bit:
  158.       begin
  159.         Inc(ScanData, X * 4);
  160.         R := Data32bit^.rgbRed;
  161.         G := Data32bit^.rgbGreen;
  162.         B := Data32bit^.rgbBlue;
  163.         Alpha := 'A = ' + IntToStr(Data32bit^.rgbReserved);
  164.       end;
  165.   end;
  166. end;
  167.  
  168. end.

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Very interesting... In Windows 11 the result is exactly the same as your picture in your last msg. RGB values change when we are in blue fields with the cursor, but the color shown in the square no. It' always the same blue. For black and white it's OK.
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
RGB values change when we are in blue fields with the cursor, but the color shown in the square no. It' always the same blue. For black and white it's OK.

The color in the square is the color of the pixel under the mouse pointer. The pixels of the blue gradient area are the pixels blended with background, which transparency has effect on their appearance. Pale blue means blue color with some transparent value, thick blue means blue pixel with 0 transparent. The pale blue and thick blue have exact same blue value, that's why the box shows the same blue on both of the pixels. Those blue pixels all have the same RGB value (0, 0, 255) but different transparency values.

The transparency of the pixel is shown as A (alpha channel) in the info area. Alpha channel means opacity of the pixel. Alpha = 255 means the pixel is opaque (0% transparent), alpha = 64 means 75% transparent.

I hope you can understand my explanation.
Anyways, thank you for testing it.
« Last Edit: August 17, 2023, 12:04:27 pm by Handoko »

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
For comparison below is the test picture in the screenshot on reply #17 https://forum.lazarus.freepascal.org/index.php/topic,37242.msg488758.html#msg488758

opened using Eye of Mate image viewer.

Some image editors and viewers will replace the background of transparent pixels with checkerboard pattern, as you can see in the screenshot below.

I generated the test image, and you maybe haven't found out that the pixel at the coordinate (10, 10) has the RGBA values of 0, 255, 0, 128 (semi transparent green). That is what the text means.
« Last Edit: August 17, 2023, 09:28:02 pm by Handoko »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2007
  • Fifty shades of code.
    • Delphi & FreePascal
I show my way of doing.
Windows exclusive.
Supported formats: All past now and future, since I go a different way :P
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
It's interesting to see how it can be done using WinApi. Unfortunately, the code can't detect transparency of image.

Anyways, thank you for sharing your mouse spy code.

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Thanks for your explanations, Handoko.
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2007
  • Fifty shades of code.
    • Delphi & FreePascal
It's interesting to see how it can be done using WinApi. Unfortunately, the code can't detect transparency of image.

Anyways, thank you for sharing your mouse spy code.
You are welcome, this was just an inspiration, for crosscompile I would do the same, snapshot with BGRA a 1x1 pixel, analyze it and output on screen what I've found.
But I am unsure about Alpha channel ....
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018