Как рисовать на холсте с прозрачностью и непрозрачностью?

Обзор

Из библиотеки GR32 я использую TImgView32 для рендеринга сетки, которая будет моим прозрачным фоном:

enter image description here

Внутри TImgView32 у меня есть регулярный TImage, где я буду рисовать на холсте, что-то вроде этого:

enter image description here

Task

То, что я хотел бы достичь, - это возможность установить непрозрачность кисти, позволяя в дальнейшем использовать возможности редактирования изображений в моей программе. Вместо того, чтобы рисовать один плоский цвет, установка непрозрачности кисти позволяет использовать различные уровни глубины цвета и т.д.

Я нашел этот вопрос раньше, ища вокруг: Нарисовать непрозрачность эллипса в Delphi 2010 - Андреас Реджбранд представил несколько примеров в своем ответе на этот вопрос.

Я посмотрел, что сделал Андреас, и придумал мою упрощенную попытку, но у меня проблема. Взгляните на следующие два изображения, первый - с прозрачным фоном, а второй с черным фоном, чтобы показать проблему более яснее:

enter image description hereenter image description here

Как вы можете видеть, вокруг кисти (круга) это действительно раздражающий квадрат, от которого я не могу избавиться. Все, что должно быть видно, - это кисть. Это мой код, используемый для получения этих результатов:

procedure DrawOpacityBrush(ACanvasBitmap: TBitmap; X, Y: Integer;
  AColor: TColor; ASize: Integer; Opacity: Integer);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.SetSize(ASize, ASize);
    Bmp.Transparent := False;

    with Bmp.Canvas do
    begin
      Pen.Color := AColor;
      Pen.Style := psSolid;
      Pen.Width := ASize;
      MoveTo(ASize div 2, ASize div 2);
      LineTo(ASize div 2, ASize div 2);
    end;

    ACanvasBitmap.Canvas.Draw(X, Y, Bmp, Opacity);
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DrawOpacityBrush(Image1.Picture.Bitmap, X, Y, clRed, 50, 85);
end;

который создает это на обычном растровом изображении:

enter image description here

Идея, которую я использовал (на основе Андреаса для создания эллипса с непрозрачностью), заключалась в том, чтобы отобразить типичную кисть на холсте, назначить ее внеэкранному растровому изображению, а затем перерисовать ее на основной растровый рисунок с непрозрачностью. Который работает, за исключением того, что раздражает квадрат вокруг края.

Как сделать кисть с непрозрачностью, как показано на скриншотах, но без этого квадрата вокруг круга кисти?

Если я установил Bmp.Transparent := True, все еще есть белый ящик, но без прозрачности. Просто сплошной белый квадрат и сплошной красный круг.

Ответ 1

Функция непрозрачности TCanvas.Draw() не поддерживает то, что вы пытаетесь сделать, по крайней мере, не так, как вы пытаетесь ее использовать. Чтобы выполнить требуемый эффект, вам нужно создать 32-разрядный TBitmap, чтобы у вас был альфа-канал на пиксель, затем заполните альфа для каждого пикселя, установив альфа-значение 0 для пикселов, которые вам не нужны, и установив альфу в желаемую непрозрачность для пикселей, которые вы хотите. Затем, вызывая TCanvas.Draw(), установите его непрозрачность на 255, чтобы указать ему использовать только непрозрачные пиксели.

procedure DrawOpacityBrush(ACanvas: TCanvas; X, Y: Integer; AColor: TColor; ASize: Integer; Opacity: Byte);
var
  Bmp: TBitmap;
  I, J: Integer;
  Pixels: PRGBQuad;
  ColorRgb: Integer;
  ColorR, ColorG, ColorB: Byte;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf32Bit; // needed for an alpha channel
    Bmp.SetSize(ASize, ASize);

    with Bmp.Canvas do
    begin
      Brush.Color := clFuchsia; // background color to mask out
      ColorRgb := ColorToRGB(Brush.Color);
      FillRect(Rect(0, 0, ASize, ASize));
      Pen.Color := AColor;
      Pen.Style := psSolid;
      Pen.Width := ASize;
      MoveTo(ASize div 2, ASize div 2);
      LineTo(ASize div 2, ASize div 2);
    end;

    ColorR := GetRValue(ColorRgb);
    ColorG := GetGValue(ColorRgb);
    ColorB := GetBValue(ColorRgb);

    for I := 0 to Bmp.Height-1 do
    begin
      Pixels := PRGBQuad(Bmp.ScanLine[I]);
      for J := 0 to Bmp.Width-1 do
      begin
        with Pixels^ do
        begin
          if (rgbRed = ColorR) and (rgbGreen = ColorG) and (rgbBlue = ColorB) then
            rgbReserved := 0
          else
            rgbReserved := Opacity; 
          // must pre-multiply the pixel with its alpha channel before drawing
          rgbRed := (rgbRed * rgbReserved) div $FF;
          rgbGreen := (rgbGreen * rgbReserved) div $FF;
          rgbBlue := (rgbBlue * rgbReserved) div $FF;
        end;
        Inc(Pixels);
      end;
    end;

    ACanvas.Draw(X, Y, Bmp, 255);
  finally
    Bmp.Free;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;  
  Shift: TShiftState; X, Y: Integer);  
begin  
  DrawOpacityBrush(Image1.Picture.Bitmap.Canvas, X, Y, clRed, 50, 85);  
end;