如何用透明与不和平的方式在罐子上画画?
原标题：How to paint on a Canvas with Transparency and Opacity?
Overview
From the GR32 library, I am using TImgView32 to render a grid which will be my transparent background like so:
Placed inside the TImgView32 I have a regular TImage, where I will be drawing onto the canvas, something like this:
Task
What I would like to achieve is the ability to set the opacity of the brush, allowing further possibilities for image editing in my program. Rather than have one flat color been drawn, setting the opacity of the brush allows different levels of color depth etc.
I found this question earlier whilst searching around: Draw opacity ellipse in Delphi 2010 - Andreas Rejbrand has provided a few examples in his answer for that question.
I have looked at what Andreas did, and came up with my own simplified attempt but I am stuck with a problem. Take a look at these next two images, the first is with the transparent background and the second with a black background to show the problem more clearer:
As you can see, around the brush (circle) is a really annoying square I cannot get rid of. All that should be visible is the brush. This is my code used to produce those results:
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;
which produces this on a regular bitmap:
The idea I had (based on Andreas way of creating an ellipse with opacity) was to render a typical brush on the canvas, assign it to a offscreen bitmap then redraw it onto the main bitmap with the opacity. Which works, except that annoying square around the edge.
How can I render a brush with opacity as illustrated in the screenshots, but without that square around the brush circle?
If I set Bmp.Transparent := True there is still a white box, but no opacity anymore. Just a solid white square and solid filled red circle.
最佳回答
The Opacity feature of TCanvas.Draw() does not support what you are trying to do, at least not the way you are trying to use it. To accomplish the effect you want, you need to create a 32-bit TBitmap so you have a per-pixel alpha channel, then fill in the alpha for each pixel, setting the alpha to 0 for pixels you don t want, and setting the alpha to the desired opacity for the pixels you do want. Then, when calling TCanvas.Draw(), set its opacity to 255 to tell it to use just the per-pixel opacities.
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;
问题回答
暂无回答
相关问题
determining the character set to use
my delphi 2009 app has a basic translation system that uses GNUGetText. i had used some win API calls to prepare the fonts. i thought it was working correctly until recently when someone from Malta ...
Help with strange Delphi 5 IDE problems
Ok, I m going nuts here. For the last (almost) four years, I ve been putting up with some extremely bad behavior from my Delphi 5 IDE. Problems include:
Seemingly random errors in coride50.bpl
...
How to write a Remote DataModule to run on a linux server?
i would like to know if there are any solution to do this. Does anyone?
The big picture: I want to access data over the web, using my delphi thin clients. But i´would like to keep my server/service ...
How convert string to integer in Oxygene
In Delphi, there is a function StrToInt() that converts a string to an integer value; there is also IntToStr(), which does the reverse. These functions doesn t appear to be part of Oxygene, and I can ...
How set dynamic array size in Oxygene (SetLength doesn t work)
What is the equivalent of SetLength using Oxygene? I m trying to size an integer array.
var listIndexes: array of integer;
begin
setLength(listIndexes,5); // doesn t work
end;
How to monitor or visualize memory fragmentation of a delphi application
How can I monitor or visualize memory fragmentation of a delphi application?
How can I troubleshoot design-time packages in Delphi/C++Builder?
I have consistently had IDE problems in Delphi/C++Builder for years, with every version. I usually just reboot, recompile, etc. and move on. However, I keep seeing others say that the IDE is rock ...
Quick padding of a string in Delphi
I was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "...
