Я рисую на холсте со способностями 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, она продолжает рисовать кисть в форме эллипса. Это плохо, потому что в зависимости от того, как быстро вы перемещаете мышь по холсту, результат не такой, как хотелось бы.
Надеюсь, эти образцы изображений должны лучше проиллюстрировать это.:
-Первая красная кисть Я довольно быстро переместил мышь из нижней части холста в верхнюю.
-Вторую красную кисть я двигал намного медленнее.
Как вы можете видеть, непрозрачность отрисовывается правильно, за исключением того, что круг продолжает рисоваться постоянно.
Вместо этого я бы хотел, чтобы он делал:
(1)Рисовал линией непрозрачности вокруг эллипса.
(2)Есть возможность вообще запретить рисование эллипсов.
Этот фиктивный пример изображения должен дать представление о том, как я хотел бы его нарисовать.:
3 фиолетовые линии кисти демонстрируют вариант (1).
Для достижения варианта (2)кругов внутри линий кисти не должно быть.
Это должно позволить вам уделять время рисованию, а не лихорадочно перемещать мышь по холсту в надежде получить нужный результат. Только когда вы решите вернуться к только что сделанному мазку кистью, непрозрачность этой области станет темнее и т. д.
Как добиться таких эффектов рисования?
Я хотел бы иметь возможность рисовать на TImage, поскольку это то, чем я сейчас занимаюсь, поэтому передача TCanvas в качестве параметра функции или процедуры была бы идеальной. Я также буду использовать события MouseDown, MouseMove и MouseUp для своего рисунка.
Это результат, который я получаю, используя метод, предоставленный NGLN.:
Непрозрачность, похоже, применяется и к изображению, это должны быть только полилинии.