Как смешать цвета (раскрасить указанным альфа-значением) область холста, используя чистый GDI?

Я хотел бы смешать цвета (раскрасить по заданному альфа-значению) области холста, используя чистый Windows GDI (так что без GDI+, DirectX или подобного, без OpenGL, без ассемблера или сторонних библиотек).

Я создал следующую функцию, и я хотел бы знать, есть ли более эффективный или более простой способ сделать это:

procedure ColorBlend(const ACanvas: HDC; const ARect: TRect;
  const ABlendColor: TColor; const ABlendValue: Integer);
var
  DC: HDC;
  Brush: HBRUSH;
  Bitmap: HBITMAP;
  BlendFunction: TBlendFunction;
begin
  DC := CreateCompatibleDC(ACanvas);
  Bitmap := CreateCompatibleBitmap(ACanvas, ARect.Right - ARect.Left,
    ARect.Bottom - ARect.Top);
  Brush := CreateSolidBrush(ColorToRGB(ABlendColor));
  try
    SelectObject(DC, Bitmap);
    Windows.FillRect(DC, Rect(0, 0, ARect.Right - ARect.Left,
      ARect.Bottom - ARect.Top), Brush);
    BlendFunction.BlendOp := AC_SRC_OVER;
    BlendFunction.BlendFlags := 0;
    BlendFunction.AlphaFormat := 0;
    BlendFunction.SourceConstantAlpha := ABlendValue;
    Windows.AlphaBlend(ACanvas, ARect.Left, ARect.Top,
      ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, DC, 0, 0,
      ARect.Right - ARect.Left, ARect.Bottom - ARect.Top, BlendFunction);
  finally
    DeleteObject(Brush);
    DeleteObject(Bitmap);
    DeleteDC(DC);
  end;
end;

Чтобы понять, что должна делать эта функция, смотрите следующие (различающие:-) изображения:

И код, который может сделать this image в верхнюю левую часть формы, как показано выше:

uses
  PNGImage;

procedure TForm1.Button1Click(Sender: TObject);
var
  Image: TPNGImage;
begin
  Image := TPNGImage.Create;
  try
    Image.LoadFromFile('d:\6G3Eg.png');
    ColorBlend(Image.Canvas.Handle, Image.Canvas.ClipRect, $0000FF80, 175);
    Canvas.Draw(0, 0, Image);
  finally
    Image.Free;
  end;
end;

Есть ли более эффективный способ сделать это, используя чистый GDI или Delphi VCL?

1 ответ

Решение

Вы пробовали рисовать на холсте с помощью AlphaBlend?

что-то вроде

Canvas.Draw(Arect.Left, ARect.Top, ABitmap, AAlphaBlendValue);

в сочетании с FillRect для смешивания цвета

Обновление: А вот код, максимально приближенный к вашему интерфейсу, но чистый VCL.
Может быть не так эффективно, но гораздо проще (и несколько портативно).
Как сказал Реми, чтобы рисовать на форме псевдопостоянным способом, вы должны использовать OnPaint...

procedure ColorBlend(const ACanvas: TCanvas; const ARect: TRect;
  const ABlendColor: TColor; const ABlendValue: Integer);
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    bmp.Canvas.Brush.Color := ABlendColor;
    bmp.Width := ARect.Right - ARect.Left;
    bmp.Height := ARect.Bottom - ARect.Top;
    bmp.Canvas.FillRect(Rect(0,0,bmp.Width, bmp.Height));
    ACanvas.Draw(ARect.Left, ARect.Top, bmp, ABlendValue);
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Image: TPNGImage;
begin
  Image := TPNGImage.Create;
  try
    Image.LoadFromFile('d:\6G3Eg.png');
    ColorBlend(Image.Canvas, Image.Canvas.ClipRect, $0000FF80, 175);
    Canvas.Draw(0, 0, Image);
    // then for fun do it to the Form itself
    ColorBlend(Canvas, ClientRect, clYellow, 15);
  finally
    Image.Free;
  end;
end;
Другие вопросы по тегам