Apply color filter to a bitmap

Question

I would need to color an image as in the example below. I would need to apply this transformation in memory, after loading the image from a file.

An example of what I would like to achieve can be found at the following link (from which I took the attached image). Another site that implements the functionality that interests me: link

The color of the filter must be customizable. I also have the ImageEn libraries available from which I started to do some tests, using the CastColorRange function, which however does not give me the expected result

var
  FIMageEn: TImageEn;
...

procedure TTest.ApplyColorMask(const ARGBFilter: TRGB);
begin
  FIMageEn.Proc.CastColorRange(FProcOverrideColorStartRange, // BeginColor
    FProcOverrideColorEndRange, // EndColor
    ARGBFilter); // Filter
end;

The problem with the piece of code shown above is that the function requires a range of colors in rgb format, but since the images are all different from each other, I don't know what range to set

Answer 1

You don't need a third-party library for this.

It looks like the desired transformation is to set the per-pixel hue (H) to a fixed value, preserving saturation (S) and value (V in the HSV colour model).

So, you merely need some RGB<->HSV conversion functions. Personally, I use my own, but I bet you can find plenty examples on the web.

Having access to such conversion functions, the rest is easy:

unit Unit6;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  protected
  private
    FBitmap, FBitmap2: TBitmap;
    FX: Integer;
  public
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  end;

var
  Form1: TForm1;

implementation

uses
  Math, ascolors;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile('K:\sample.bmp');

  FBitmap2 := TBitmap.Create;
  FBitmap2.Assign(FBitmap);
  FBitmap2.PixelFormat := pf32bit;

  {$POINTERMATH ON}
  for var y := 0 to FBitmap2.Height - 1 do
  begin
    var sl: PRGBQuad := FBitmap2.ScanLine[y];
    for var x := 0 to FBitmap2.Width - 1 do
    begin
      var ColorRgb := TRGB.Create(sl[x].rgbRed / 255, sl[x].rgbGreen / 255, sl[x].rgbBlue / 255);
      var ColorHsv := THSV(ColorRgb);
      ColorHsv.Hue := 0;
      ColorRgb := TRGB(ColorHsv);
      sl[x].rgbRed := Round(255 * ColorRgb.Red);
      sl[x].rgbGreen := Round(255 * ColorRgb.Green);
      sl[x].rgbBlue := Round(255 * ColorRgb.Blue);
    end;
  end;

  FX := FBitmap.Width div 2;
  ClientWidth := FBitmap.Width;
  ClientHeight := FBitmap.Height;

end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FX := X;
  Invalidate;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if csLButtonDown in ControlState then
  begin
    FX := X;
    Invalidate;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  BitBlt(
    Canvas.Handle,
    0,
    0,
    Min(FBitmap.Width, FX),
    FBitmap.Height,
    FBitmap.Canvas.Handle,
    0,
    0,
    SRCCOPY
  );
  BitBlt(
    Canvas.Handle,
    FX,
    0,
    Max(0, FBitmap.Width - FX),
    FBitmap.Height,
    FBitmap2.Canvas.Handle,
    FX,
    0,
    SRCCOPY
  );
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Invalidate;
end;

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

end.