How do I detect the tone of a region of a TImage in Delphi

Question

I am adding overlays to user-submitted images and that means the images might be dark in tone or light in tone. Is there some kind of mechanism by which I can determine whether a particular region of a Timage is tonally light or dark? This will allow me to show the white or black version of my overlay depending. I am using Delphi 10.4 for MacOS so I am working with FMX. The overlay is a small piece of text and an image (in black or white).

This will be overlaying a TImage found in my stylebook definition for a TListboxItem.

Just average the RGB components over the region and see if the average is less than or greater than or equal to 127. That very simple approach works fine in most situations. — Andreas Rejbrand, Nov 30 '21 at 18:12
@AndreasRejbrand Precieved brightness can not be calculated only by averaging the RGB values since Red Green and Blue colors are perceived differently. YOu can find both formulas and more information on this topic in [this answer](https://stackoverflow.com/a/596243/3636228) — SilverWarior, Dec 01 '21 at 07:17
@SilverWarior: I am very aware of that, which I tried to suggest by my choice of words: "very simple". — Andreas Rejbrand, Dec 01 '21 at 07:19
@AndreasRejbrand True. But OP is trying to determine which overlay version to use in order for making it stand out the most. And for that working with perceived brightness is much more effective. — SilverWarior, Dec 01 '21 at 07:22
In terms of getting the pixel values in a region, you will need to use TBitmapData. Create a TBitmapData object and map it to the Bitmap of your Image. Then get a pixel value using GetPixel. If you're averaging a large region then it may be faster to use GetScanline for each image row. — XylemFlow, Dec 01 '21 at 15:58

XylemFlow · Answer 1 · 2021-12-01T17:08:02.447

This function will return the average luminance given a bitmap and a region. It uses a fast weighted average. It doesn't take into account the alpha channel of the image.

function LumBitmapRegion(const ABitmap : TBitmap ; ARegion : TRect) : Byte;
Var
  Lx, Ly : Integer;
  LSum : Cardinal;
  bdata : TBitmapData;
  LRow : PAlphaColorArray;
  pt : PByte;
  LLum : Word;
begin
  LSum := 0;
  ABitmap.Map(TMapAccess.Read, bdata);
  ARegion.Intersect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
try
  for Ly := ARegion.Top to ARegion.Bottom - 1 do begin
    LRow := bdata.GetScanline(Ly);
    pt := @TAlphaColorRec(LRow[ARegion.Left]).B;
    for Lx := ARegion.Left to ARegion.Right - 1 do begin
      // Y = (R+R+R+B+G+G+G+G)>>3
      LLum := pt^; Inc(pt);
      Inc(LLum, pt^ shl 2); Inc(pt);
      Inc(LLum, pt^ * 3); Inc(pt, 2);
      LLum := LLum shr 3;
      Inc(LSum, LLum);
    end;
  end;

  Result := LSum div Cardinal(ARegion.Width * ARegion.Height);
finally
  ABitmap.Unmap(bdata);
end;
end;

Here's a demo application. Load an image by clicking the button and click the image to center the rectangle in that spot. The label will show the luminance between 0 and 255.

Form:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 480
  ClientWidth = 640
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object Image1: TImage
    MultiResBitmap = <
      item
      end>
    Position.X = 8.000000000000000000
    Position.Y = 8.000000000000000000
    Size.Width = 441.000000000000000000
    Size.Height = 409.000000000000000000
    Size.PlatformDefault = False
    OnMouseDown = Image1MouseDown
  end
  object Button1: TButton
    Position.X = 512.000000000000000000
    Position.Y = 32.000000000000000000
    Text = 'Load Image'
    OnClick = Button1Click
  end
  object Rectangle2: TRectangle
    Fill.Kind = None
    Position.X = 240.000000000000000000
    Position.Y = 216.000000000000000000
    Size.Width = 50.000000000000000000
    Size.Height = 50.000000000000000000
    Size.PlatformDefault = False
  end
  object Label1: TLabel
    Position.X = 504.000000000000000000
    Position.Y = 168.000000000000000000
    Text = 'Label1'
  end
  object OpenDialog1: TOpenDialog
    Left = 496
    Top = 72
  end
end

Unit:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;

type
  TForm1 = class(TForm)
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Rectangle2: TRectangle;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
  private
    { Private declarations }
    procedure UpdateLum;
  public
    { Public declarations }
  end;

  function LumBitmapRegion(const ABitmap : TBitmap ; ARegion : TRect) : Byte;

var
  Form1: TForm1;

implementation

uses
  FMX.Utils;

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if not OpenDialog1.Execute then Exit;

  Image1.Bitmap.LoadFromFile(OpenDialog1.FileName);
  Image1.Width := Image1.Bitmap.Width;
  Image1.Height := Image1.Bitmap.Height;

  UpdateLum;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  Rectangle2.Position.Point := PointF(X, Y) +
                               Image1.Position.Point.Round -
                               PointF(Rectangle2.Width, Rectangle2.Height)/2;
  UpdateLum;
end;

procedure TForm1.UpdateLum;
var
  LRect : TRect;
  LLum : Byte;
begin
  LRect := Rectangle2.AbsoluteRect.Round;
  LRect.Offset(TPoint.Zero - Image1.Position.Point.Round);
  LLum := LumBitmapRegion(Image1.Bitmap, LRect);
  Label1.Text := IntToStr(LLum);
  if LLum < 128 then Rectangle2.Stroke.Color := $FFFFFFFF
                else Rectangle2.Stroke.Color := $FF000000;

end;

function LumBitmapRegion(const ABitmap : TBitmap ; ARegion : TRect) : Byte;
Var
  Lx, Ly : Integer;
  LSum : Cardinal;
  bdata : TBitmapData;
  LRow : PAlphaColorArray;
  pt : PByte;
  LLum : Word;
begin
  LSum := 0;
  ABitmap.Map(TMapAccess.Read, bdata);
  ARegion.Intersect(Rect(0, 0, ABitmap.Width, ABitmap.Height));
try
  for Ly := ARegion.Top to ARegion.Bottom - 1 do begin
    LRow := bdata.GetScanline(Ly);
    pt := @TAlphaColorRec(LRow[ARegion.Left]).B;
    for Lx := ARegion.Left to ARegion.Right - 1 do begin
      // Y = (R+R+R+B+G+G+G+G)>>3
      LLum := pt^; Inc(pt);
      Inc(LLum, pt^ shl 2); Inc(pt);
      Inc(LLum, pt^ * 3); Inc(pt, 2);
      LLum := LLum shr 3;
      Inc(LSum, LLum);
    end;
  end;

  Result := LSum div Cardinal(ARegion.Width * ARegion.Height);
finally
  ABitmap.Unmap(bdata);
end;
end;

end.

How do I detect the tone of a region of a TImage in Delphi

1 Answers1