Рисование на холсте -Как улучшить процедуру альфа-рисования?

Я рисую на холсте со способностями Opacity (Alpha Transparency )вот так:

var
  Form1: TForm1;

  IsDrawing: Boolean;

implementation

{$R *.dfm}

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.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft:
    begin
      IsDrawing := True;
      DrawOpacityBrush(Form1.Canvas, X, Y, clRed, 50, 85);
    end;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (GetAsyncKeyState(VK_LBUTTON) <> 0) and
     (IsDrawing) then
  begin
    DrawOpacityBrush(Form1.Canvas, X, Y, clRed, 50, 85);
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDrawing := False;
end;

Процедура рисования DrawOpacityBrush()была обновлением Реми Лебо по предыдущему вопросу, который я недавно задал:Как рисовать на холсте с прозрачностью и непрозрачностью?

Хотя это и работает, результаты не соответствуют тому, что мне сейчас нужно.

В настоящее время каждый раз, когда процедура DrawOpacityBrush()вызывается в MouseMove, она продолжает рисовать кисть в форме эллипса. Это плохо, потому что в зависимости от того, как быстро вы перемещаете мышь по холсту, результат не такой, как хотелось бы.

Надеюсь, эти образцы изображений должны лучше проиллюстрировать это.:

enter image description here

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

Как вы можете видеть, непрозрачность отрисовывается правильно, за исключением того, что круг продолжает рисоваться постоянно.

Вместо этого я бы хотел, чтобы он делал:

(1)Рисовал линией непрозрачности вокруг эллипса.

(2)Есть возможность вообще запретить рисование эллипсов.

Этот фиктивный пример изображения должен дать представление о том, как я хотел бы его нарисовать.:

enter image description here

3 фиолетовые линии кисти демонстрируют вариант (1).

Для достижения варианта (2)кругов внутри линий кисти не должно быть.

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

Как добиться таких эффектов рисования?

Я хотел бы иметь возможность рисовать на TImage, поскольку это то, чем я сейчас занимаюсь, поэтому передача TCanvas в качестве параметра функции или процедуры была бы идеальной. Я также буду использовать события MouseDown, MouseMove и MouseUp для своего рисунка.

Это результат, который я получаю, используя метод, предоставленный NGLN.:

enter image description here

Непрозрачность, похоже, применяется и к изображению, это должны быть только полилинии.

6
задан Community 23 May 2017 в 10:32
поделиться