Canvas Drawing - How can I Improve this Alpha Drawing routine?

Question

I am drawing onto a canvas with Opacity (Alpha Transparency) abilities like so:

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;

The draw DrawOpacityBrush() procedure was an update by Remy Lebeau on a previous question I recently asked: How to paint on a Canvas with Transparency and Opacity?

While this works, the results are not satisfactory to what I now need.

Currently, every time the DrawOpacityBrush() procedure is called in MouseMove it keeps on drawing the brush ellipse shape. This is bad because depending on how quick you move the mouse around the canvas, the output is not as hoped.

These sample images should illustrate this better hopefully:

enter image description here

- The first red brush I moved the mouse pretty rapidly from the bottom of the canvas to the top.
- The second red brush I moved a lot slower.

As you can see the opacity is drawn correctly, except that the circle keeps on drawing repeatedly as well.

What I would like it to do instead is:

(1) Paint with a opacity line around the ellipse.

(2) Have an option to prevent any ellipses been drawn at all.

This mock sample image should give an idea of how I would like it to be drawn:

enter image description here

The 3 purple brush lines demonstrate option (1).

To achieve option (2) the circles inside the brush lines should not be there.

This should then allow you to take time when drawing, not frantically moving the mouse around the canvas in hope of getting the result you need. Only when you decide to go back over the brush stroke you just made will the opacity for that area become darker etc.

How can I achieve these type of drawing effects?

I would like to be able to draw onto a TImage as that is what I am currently doing, so passing TCanvas as a parameter in a function or procedure would be ideal. I will also be using the MouseDown, MouseMove and and MouseUp events for my drawing.

This is the output I get using the method provided by NGLN:

enter image description here

Opacity seems to be applied to the image too, it should only be the poly lines.

"Making requirements more clear" is changing the question after someone has answered to the question at hand. Better ask a new question carefully thinking about requirements beforehand. — Sertac Akyuz, Apr 29 '12 at 16:40
Well to be fair given the example I had posted uses TCanvas, the answer I got from NGLN does not include this parameter, but a different method. Maybe I should have used Image1MouseDown instead of Form1MouseDown in my example. And the question title states Canvas also.. — , Apr 29 '12 at 18:51

NGLN · Accepted Answer · 2012-05-05T12:47:02.867

9

Why not just draw a polyline then?

unit Unit1;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, ExtCtrls;

type
  TPolyLine = record
    Count: Integer;
    Points: array of TPoint;
  end;

  TPolyLines = array of TPolyLine;

  TForm1 = class(TForm)
    PaintBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
     procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBoxPaint(Sender: TObject);
  private
    FBlendFunc: BLENDFUNCTION;
    FBmp: TBitmap;
    FPolyLineCount: Integer;
    FPolyLines: TPolyLines;
    procedure AddPoint(APoint: TPoint);
    function LastPoint: TPoint;
    procedure NewPolyLine;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddPoint(APoint: TPoint);
begin
  with FPolyLines[FPolyLineCount - 1] do
  begin
    if Length(Points) = Count then
      SetLength(Points, Count + 64);
    Points[Count] := APoint;
    Inc(Count);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBmp := TBitmap.Create;
  FBmp.Canvas.Brush.Color := clWhite;
  FBmp.Canvas.Pen.Width := 30;
  FBmp.Canvas.Pen.Color := clRed;
  FBlendFunc.BlendOp := AC_SRC_OVER;
  FBlendFunc.SourceConstantAlpha := 80;
  DoubleBuffered := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBmp.Free;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  FBmp.Width := PaintBox.Width;
  FBmp.Height := PaintBox.Height;
end;

function TForm1.LastPoint: TPoint;
begin
  with FPolyLines[FPolyLineCount - 1] do
    Result := Points[Count - 1];
end;

procedure TForm1.NewPolyLine;
begin
  Inc(FPolyLineCount);
  SetLength(FPolyLines, FPolyLineCount);
  FPolyLines[FPolyLineCount - 1].Count := 0;
end;

procedure TForm1.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
  begin
    NewPolyLine;
    AddPoint(Point(X, Y));
    PaintBox.Invalidate;
  end;
end;

procedure TForm1.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssLeft in Shift then
    if Sqr(LastPoint.X - X) + Sqr(LastPoint.Y - Y) > 30 then
    begin
      AddPoint(Point(X, Y));
      PaintBox.Invalidate;
    end;
end;

procedure TForm1.PaintBoxPaint(Sender: TObject);
var
  R: TRect;
  I: Integer;
begin
  R := PaintBox.ClientRect;
  FBmp.Canvas.FillRect(R);
  for I := 0 to FPolyLineCount - 1 do
    with FPolyLines[I] do
      FBmp.Canvas.Polyline(Copy(Points, 0, Count));
  Windows.AlphaBlend(PaintBox.Canvas.Handle, 0, 0, R.Right, R.Bottom,
    FBmp.Canvas.Handle, 0, 0, R.Right, R.Bottom, FBlendFunc);
end;

end.

Blended polylines

The second picture shows how to combine this with a background and is gotten with the following minor addition to the code, whereas FGraphic is a runtime loaded picture:

procedure TForm1.PaintBoxPaint(Sender: TObject);
var
  R: TRect;
  I: Integer;
begin
  R := PaintBox.ClientRect;
  FBmp.Canvas.FillRect(R);
  for I := 0 to FPolyLineCount - 1 do
    with FPolyLines[I] do
      FBmp.Canvas.Polyline(Copy(Points, 0, Count));
  PaintBox.Canvas.StretchDraw(R, FGraphic);
  Windows.AlphaBlend(PaintBox.Canvas.Handle, 0, 0, R.Right, R.Bottom,
    FBmp.Canvas.Handle, 0, 0, R.Right, R.Bottom, FBlendFunc);
end;

Or, to combine already drawn work (like your Image), copy its canvas to the PaintBox:

procedure TForm1.PaintBoxPaint(Sender: TObject);
var
  R: TRect;
  I: Integer;
begin
  R := PaintBox.ClientRect;
  FBmp.Canvas.FillRect(R);
  FBmp.Canvas.Polyline(Copy(FPoly, 0, FCount));
  for I := 0 to FPolyLineCount - 1 do
    with FPolyLines[I] do
      FBmp.Canvas.Polyline(Copy(Points, 0, Count));
  Windows.AlphaBlend(PaintBox.Canvas.Handle, 0, 0, R.Right, R.Bottom,
    FBmp.Canvas.Handle, 0, 0, R.Right, R.Bottom, FBlendFunc);
end;

But alike David mentioning in the comments, I also strongly advise to draw everything on the PaintBox: that is what it is for.

edited May 05 '12 at 12:47

answered Apr 29 '12 at 12:23

NGLN

43,011
8
105
200

How do I do this on a TImage Canvas? I can only seem to work it on the form. – Apr 29 '12 at 13:33
1

you'll need a TPaintbox rather than a TImage. – David Heffernan Apr 29 '12 at 14:55
Hi David, I really would like to do this on a TImage as that is what I have been doing so far for loading/saving and painting on the canvas etc. – Apr 29 '12 at 15:42
1

You'll need to use a paintbox. Your current code is completely broken anyway since you paint on mouse down rather than inside a Paint method. – David Heffernan Apr 29 '12 at 16:03
Yeah that Form.Paint method has completely thrown me off. If I could specific a TCanvas as a parameter and use the MouseDown, MouseMove and MouseUp events then I think I am good to go :) – Apr 29 '12 at 16:18
1

No. You cannot draw in mouse events. **You must draw in response to WM_PAINT**. That's a hard rule. That means a `Paint` override, or a paint box. As I said in my previous comment, your current code is completely broken. Try dragging another window across the top of it. – David Heffernan Apr 29 '12 at 16:39
You **can** draw on a `TImage` in mouse events, since the drawing will be on to a persistent `TBitmap` and the `TImage` will handle the `WM_PAINT` for you. It is possible to solve this problem with a few small adjustments to Blobby's existing code, but the overall visual effects will not be as clean as it could be. I agree that switching to a `TPaintBox` and using `Polyline()` would produce a cleaner visual effect. – Remy Lebeau Apr 30 '12 at 05:03
Have the mouse events store each set of X/Y coordinates in a list and then `Invalidate()` the `TPaintBox` so the `TPaintBox.OnPaint` event can draw the base image and make a single call to `Polyline()` to draw the complete line on top of it. – Remy Lebeau Apr 30 '12 at 05:11
The problem I am facing with this is when I set `FBlendFunc.SourceConstantAlpha` to a value it fades the image aswell as the brush. If I replace FGraphic with Image1.Picture.Bitmap and set `FBlendFunc.SourceConstantAlpha` to say 255 the paintbox becomes white. I had hoped to set the opacity of the poly line between 0-255 without affecting the Image bitmap been drawn onto the Paintbox. – Apr 30 '12 at 18:24
@Blobby Like in my second last code where I first draw an image on the PaintBox and after that I blend the polyline on top of it, you have to copyrect your image with the last code I gave (instead of the line `PaintBox.Canvas.StretchDraw()`). Thus: first paint the image to the paintbox, then draw (alphablend) the polyline on top of it. Just like in my example, right? – NGLN Apr 30 '12 at 23:10
@Blobby What's so difficult to understand from my answer and comments? I have edited the answer. But why your code does not work is obviously because of the order in which you paint. You draw the polyline on the bitmap after you have painted the bitmap to the paintbox. Then the polyline will not see the daylight ever, will it? Also, you don't have to adjust the blendfunction prior to drawing the image: the blendfunction works on the bitmap, not on the paintbox nor image. – NGLN May 01 '12 at 16:02
I don't know but it still didnt work for me. I will accept your answer anyway, but it is not what I am looking for. I just want a simple routine to draw an alpha line on a canvas, and as described in my question if you redraw over the already drawn alpha line the line would become darker. Thanks anyway for your help :) – May 03 '12 at 14:45
@Blobby If the answer isn't satisfactory then don't accept it: SO isn't about sympathy, nor am I. But to take away your confusion: Then first draw all the different polylines (or whatever you want to be blended) on the temporary bitmap and alphablend that all together in one step to the final canvas. It is all the very same technique using over again. I updated my answer with an example of drawing multiple polylines over each other without darkening the intersections. Good luck! – NGLN May 04 '12 at 17:37
I wasn't looking for sympathy, I just couldn't (cannot) get this to work. Also your last edit has some syntax errors, notably the last PaintBoxPaint(Sender: TObject); code. I: Integer is missing and some FPoly errors I could not fix. Would it be too much trouble to ask if you could post the full DFM and unit source because what ever I try just won't work. Thanks :) – May 05 '12 at 10:33
@Blobby [Here is the complete project](https://skydrive.live.com/redir.aspx?cid=ed0ca85c18876a79&resid=ED0CA85C18876A79!116&parid=ED0CA85C18876A79!115&authkey=!AB6RNZ5lUMViGuQ) – NGLN May 05 '12 at 12:41
Very odd, compiling the demo you supplied still makes the background image change its opacity too. See my question, I edited it to provide a sample image to show this. The pacman type of image I drew in MS Paint and saved as bitmap. I appreciate your help, but I dont understand why the images drawn on the Paintbox canvas look different. – May 05 '12 at 14:52
@Blobby, you won't get any better answers than NGLN will serve you with. The question has been altered a bit since asked, so better to withdraw your last edit and ask a new question. – LU RD May 05 '12 at 17:23

Canvas Drawing - How can I Improve this Alpha Drawing routine?

1 Answers1