将颜色滤镜应用于位图

Question

我需要为图像着色，如下例所示。从文件加载图像后，我需要在内存中应用此转换。

我想要实现的示例可以在以下链接中找到（我从中获取了所附图片）。另一个实现我感兴趣的功能的网站：链接

过滤器的颜色必须是可定制的。我也有可用的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

为此，您不需要第三方库。

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

因此，您只需要一些 RGB<->HSV 转换函数。就我个人而言，我使用自己的，但我打赌您可以在网上找到很多示例。

访问此类转换函数后，剩下的就很简单了：

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.