Draw Line with Mouse Down and Move using buffer and BitBlt

[Boleeman]

Hi All.

I was working with a Delphi line drawing code that uses a buffer and BitBlt and mouse down and move events but the canvas goes black and the line disappears when the mouse is released. I tried altering the brush color and filling (an earlier delphi program needed to be filled with another color) but that did not work. Not sure why the canvas is turning black.

I have another code that uses XOR (which works) but I wondered what the fault is with the code below.

Here is the code:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   LCLIntf, LCLType, Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     procedure FormCreate(Sender: TObject);
16.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
17.       Shift: TShiftState; X, Y: Integer);
18.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
19.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
20.       Shift: TShiftState; X, Y: Integer);
21.     procedure FormPaint(Sender: TObject);
22.     procedure FormResize(Sender: TObject);
23.   private
24.  
25.     FStartPoint, FEndPoint: TPoint;
26.     FDrawingLine: boolean;
27.     bm: TBitmap;
28.     procedure AddLineToCanvas;
29.     procedure SwapBuffers;
30.   public
31.  
32.   end;
33.  
34. var
35.   Form1: TForm1;
36.  
37. implementation
38.  
39. {$R *.lfm}
40.  
41. { TForm1 }
42.  
43.  
44. procedure TForm1.FormCreate(Sender: TObject);
45. begin
46.   bm := TBitmap.Create;
47.   FDrawingLine := false;
48.   //Canvas.Brush.Style:=bsSolid;
49.   //canvas.Brush.Color := clSilver;
50.   //canvas.FillRect(0, 0, bm.Width, bm.Height);
51.   //Canvas.Brush.Color:=clwhite;
52.   //Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
53. end;
54.  
55. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
56.   Shift: TShiftState; X, Y: Integer);
57. begin
58.   if Button = mbLeft then begin
59.     Canvas.Pen.Color:=clRed;
60.     FStartPoint := Point(X, Y);
61.     FDrawingLine := true;
62.   end;
63. end;
64.  
65. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
66.   Y: Integer);
67. begin
68.   if FDrawingLine then
69.   begin
70.     SwapBuffers;
71.     Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
72.     Canvas.LineTo(X, Y);
73.   end;
74. end;
75.  
76. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
77.   Shift: TShiftState; X, Y: Integer);
78. begin
79.   FDrawingLine := false;
80.   FEndPoint := Point(X, Y);
81.   AddLineToCanvas;
82.   SwapBuffers;
83.  
84. end;
85.  
86. procedure TForm1.AddLineToCanvas;
87. begin
88.   bm.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
89.   bm.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
90. end;
91.  
92. procedure TForm1.FormPaint(Sender: TObject);
93. begin
94.   SwapBuffers;
95.  
96. end;
97.  
98. procedure TForm1.FormResize(Sender: TObject);
99. begin
100.   bm.SetSize(ClientWidth, ClientHeight);
101. end;
102.  
103. procedure TForm1.SwapBuffers;
104. begin
105.   BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
106.   bm.Canvas.Handle, 0, 0, SRCCOPY);
107.  
108. end;
109.  
110.  
111. end.
112.  

Thanks in advance.  Take care all.

[wp]

The difference between Delphi and Lazarus is that Lazarus initializes the bitmap with "everything zero", i.e. fill color black (clBlack = 0) while Delphi initializes it with fill color white. Since you do not change the color of the bitmap pen it remains at its default, black. So - you are painting black on black... However, you can set the bm.Canvas.Pen.Color in the AddLineToCanvas procedure, and the code will work:

Code: Pascal  [Select][+][-]

1. procedure TForm1.AddLineToCanvas;
2. begin
3.   bm.Canvas.Pen.Color := clRed;
4.   bm.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
5.   bm.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
6. end;

What if you want a different background color than black? Normally you fill the bitmap with the background color after its size has been set. The first place where this happens is the OnCreate handler of the form where the bitmap is created:

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   bm := TBitmap.Create;
4.   bm.SetSize(ClientWidth, ClientHeight);
5.   bm.Canvas.Brush.Color := clWhite;
6.   bm.Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
7.   FDrawingLine := false;
8. end;

The next issue is when you increase the form size: Now the original black background color returns at the newly exposed areas... Since the bitmap is resized in the OnResize event handler you could call bm.Canvas.FillRect again - but this would erase the drawing accumulated so far. A solution (maybe there are better ones) could be to create a new temporary bitmap for the new size, fill it white and copy the old bitmap over it. Note that the temporary bitmap must be at least as large as the old bitmap, otherwise parts of the old bitmap possibly could be truncated:

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormResize(Sender: TObject);
2. var
3.   tmpBm: TBitmap;
4.   w, h: Integer;
5. begin
6.   if ClientWidth > bm.Width then w := ClientWidth else w := bm.Width;
7.   if ClientHeight > bm.Height then h := ClientHeight else h := bm.Height;
8.   tmpBm := TBitmap.Create;
9.   tmpBm.SetSize(w, h);
10.   tmpBm.Canvas.Brush.Color := clWhite;
11.   tmpBm.Canvas.FillRect(0, 0, tmpBm.Width, tmpBm.Height);
12.   tmpBm.Canvas.Draw(0, 0, bm);
13.   bm.Free;
14.   bm := tmpBm;
15. end;

[Boleeman]

 Thanks WP for your help.

I thought  Lazarus initializes the bitmap with "everything zero", i.e. fill color black (clBlack = 0) but I tried every combination, but left the procedure TForm1.AddLineToCanvas;   alone.

All works well now with your helpful hints.

Had a similar issue black screen issue with a draw arrow Delphi code. Fixed the black screen by adding:

procedure TForm1.FormCreate(Sender: TObject);
begin
  image1.canvas.Brush.Color := clWhite;
  image1.canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end;

Now to work out why arrow line not showing when moving mouse.
Mouse move event not there. What to add here?

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Math, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Image1: TImage;
16.     procedure FormCreate(Sender: TObject);
17.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
18.       Shift: TShiftState; X, Y: Integer);
19.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
20.       Shift: TShiftState; X, Y: Integer);
21.   private
22.  
23.   public
24.  
25.   end;
26.  
27. var
28.   Form1: TForm1;
29.   BeginPoint: TPoint;
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TForm1 }
35.  
36. procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
37.   Shift: TShiftState; X, Y: Integer);
38. begin
39.   BeginPoint.X := X;
40.   BeginPoint.Y := Y;
41. end;
42.  
43. procedure TForm1.FormCreate(Sender: TObject);
44. begin
45.  
46.   image1.canvas.Brush.Color := clWhite;
47.   image1.canvas.FillRect(0, 0, ClientWidth, ClientHeight);
48.  
49. end;
50.  
51. procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
52.   Shift: TShiftState; X, Y: Integer);
53. var
54.   B, deltaX, deltaY: Extended;
55. begin
56.   Image1.Canvas.PenPos := BeginPoint;
57.   // Beginpoint is the point from where the use drew the line
58.   Image1.Canvas.LineTo(X, Y);
59.  
60.   if BeginPoint.X <> X then // checks for division by zero
61.   begin
62.     if (BeginPoint.X > X) then
63.       B := DegToRad(135) - ArcTan((BeginPoint.Y - Y) / (BeginPoint.X - X))
64.     else
65.       B := DegToRad(45) - ArcTan((BeginPoint.Y - Y) / (BeginPoint.X - X));
66.     // the arrow will have a 45 deg corner
67.  
68.     deltaX := 15 * Cos(B); // 15 is the length of the arrow
69.     deltaY := 15 * Sin(B);
70.  
71.     if (BeginPoint.X > X) then
72.     begin
73.       Image1.Canvas.PenPos := Point(X, Y);
74.       Image1.Canvas.LineTo(X - Trunc(deltaX), Y + Trunc(deltaY));
75.       Image1.Canvas.PenPos := Point(X, Y);
76.       Image1.Canvas.LineTo(X + Trunc(deltaY), Y + Trunc(deltaX));
77.     end
78.     else
79.     begin
80.       Image1.Canvas.PenPos := Point(X, Y);
81.       Image1.Canvas.LineTo(X - Trunc(deltaX), Y + Trunc(deltaY));
82.       Image1.Canvas.PenPos := Point(X, Y);
83.       Image1.Canvas.LineTo(X - Trunc(deltaY), Y - Trunc(deltaX));
84.     end;
85.   end
86.   else
87.   begin
88.     if BeginPoint.Y > Y then
89.     begin
90.       Image1.Canvas.PenPos := Point(X, Y);
91.       Image1.Canvas.LineTo(X + 10, Y + 10);
92.       Image1.Canvas.PenPos := Point(X, Y);
93.       Image1.Canvas.LineTo(X - 10, Y + 10);
94.     end
95.     else
96.     begin
97.       Image1.Canvas.PenPos := Point(X, Y);
98.       Image1.Canvas.LineTo(X + 10, Y - 10);
99.       Image1.Canvas.PenPos := Point(X, Y);
100.       Image1.Canvas.LineTo(X - 10, Y - 10);
101.     end;
102.   end;
103. end;
104.  
105. end.
106.  

[wp]

Hmmm... I don't know, but I think that this is not going to work. The problem is that TImage has a persistent canvas, you can draw outside the paint cycle since whatever you draw goes into a buffer bitmap. You can see this when you drag the form with the image (on which you painted something) out of the screen, and when you drag the form back the drawing is still there - when you do the same with a drawing on a form the drawing will be erased at least partially.

When you want to see the line while you are dragging the mouse you must draw the line. In the example you draw on the persistent image canvas - in other words: and all the intermediate lines will remain! Therefore the guy who submitted the code that you are using only showed the final line, i.e. the line at the moment when the mouse button is released.

If you want to see the line while dragging the mouse you must not draw on a TImage. Draw on the form instead, or on a TPanel or on a TPaintbox, and apply the code that you had used in the initial post of this thread. In that other code there are two canvases: the canvas of the form for the temporary line dragged across the form, and the canvas of a bitmap which accumulates all the previously drawn lines. This bitmap was painted on the form in its OnPaint event. This means that whenever the operating system gives the command to the form to redraw itself the form executes the OnPaint event handler and the bitmap appears. But while you draw the line and drag the mouse the line was painted on the form's canvas - this is not persistent and the drawing is erased whenever the operating system requests a repaint. In particular the code called SwapBuffers which redraws the bitmap on the form and then draws the line, i.e. the previous version of the line is erased. On MouseUp the line was painted to the bitmap, where it is persistent. The bitmap with the new line can be redrawn onto the form whenever needed.

(Hmmm - I notice, it's hard to explain...)

[Boleeman]

WP. I sort of understand what you are saying. Use two canvas'


I made a few dynamically draw arrow programs in VB6 using XOR.
In VB6 it was not that hard to draw on canvas or on picture box.
Attached are pics and one vb6 program.

But ... Lazarus calls for some extra thinking strategies.

[wp]

Attaching a mini Paint application which allows you to draw rectangles, ellipses, lines or arrow-lines following the idea of the first post.

The arrow is drawn by means of a procedure in the GraphUtil unit (https://lazarus-ccr.sourceforge.io/docs/lcl/graphutil/drawarrow.html).

[Boleeman]

A really nice "to learn off" example.  I love the nice clean GUI.

Thanks WP.

Now I see how to make use of a buffer. I saw something similar in VB6 years ago but did not realize why they did it.

I also came across some efg Delphi code for arrow drawing that does a proportion size of the triangle, according to how long the line is.
OOPs: forgot to attach the Delphi code converted to Lazarus. Attaching it now.