将颜色过滤器应用于位图

Question

我需要像下面的例子一样给图像上色。从文件加载图像后，我需要在内存中应用此转换。

可以在下面找到我想要实现的示例 link (from which I took the attached image). Another site that implements the functionality that interests me: link

过滤器的颜色必须可自定义。我也有可用的 ImageEn 库，我从中开始使用 CastColorRange 函数进行一些测试，但是它没有给我预期的结果

var
  FIMageEn: TImageEn;
...

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

上面这段代码的问题是函数需要一个rgb格式的颜色范围，但是由于图片各不相同，我不知道设置什么范围

Answer 1

为此您不需要 third-party 库。

看起来所需的转换是将 per-pixel 色调 (H) 设置为固定值，同时保留饱和度 (S) 和值（HSV 颜色模型中的 V）。

因此，您只需要一些RGB<->HSV 转换函数。就我个人而言，我使用 my own，但我敢打赌您可以在网上找到大量示例。

有了这样的转换函数，剩下的就简单了：

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.

将颜色过滤器应用于位图

Apply color filter to a bitmap

delphi

image-processing