Can anybody help me convert this great method of dynamically drawing a line (Photoshop style drawing line with delphi) to Graphics32?
I mean, I want to have a ImgView, add a new layer to it, then perform these methods on the layer instead of the form's canvas.
So I assume, my code should look like this:
private
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
bm32 := TBitmap32.Create;
FDrawingLine := false;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
with ImgView do
begin
Selection := nil;
RBLayer := nil;
Layers.Clear;
Scale := 1;
Bitmap.SetSize(800, 600);
Bitmap.Clear(clWhite32);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
B : TBitmapLayer;
P: TPoint;
W, H: Single;
begin
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
Bitmap.DrawMode := dmBlend;
with ImgView.Bitmap do Location := GR32.FloatRect(0, 0, 600, 400);
Scaled := True;
OnMouseDown := LayerMouseDown;
OnMouseUp := LayerMouseUp;
OnMouseMove := LayerMouseMove;
OnPaint := LayerOnPaint;
except
Free;
raise;
end;
end;
I assume this code because those are the events used in the regular canvas drawing method from the link, but the rest of the methods do not work like they should
procedure TForm1.AddLineToLayer;
begin
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm1.SwapBuffers32;
begin
BitBlt(imgView.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,bm32.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TForm1.SwapBuffers;
begin
BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
bm.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TForm1.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X, Y);
FDrawingLine := true;
end;
procedure TForm1.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X, Y);
AddLineToLayer;
SwapBuffers;
end;
procedure TForm1.LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers;
ImgView.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
ImgView.Canvas.LineTo(X, Y);
end;
end;
procedure TForm1.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers;
end;
So it does not work. Nothing happens. Can anybody assist me in making this work like in the normal canvas drawing? I want to make this happen for just one layer, the layer I create with Button1Click... (ImgView is a ImgView32 control placed on the form, and there is also a button on the form)
the result looks like this (with error saying that Canvas does not allow drawing) First time the error appears onButtonClick, then after I Ok it, I start drawing, it does not erase the moving lines (just like in the image above), then onMouseUp the Canvas error appears again.
What am I doing wrong?
If I use SwapBuffers32, nothing gets drawn , and canvas errors keep showing up.
EDIT: I made a few changes just to try making it work after Tom Brunberg's suggestions and I ended up with this code:
private
FStartPoint, FEndPoint: TPoint;
FDrawingLine: boolean;
bm32: TBitmap32;
B : TBitmapLayer;
FSelection: TPositionedLayer;
public
procedure AddLineToLayer;
procedure SwapBuffers32;
procedure LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
procedure LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
procedure SetSelection(Value: TPositionedLayer);
property Selection: TPositionedLayer read FSelection write SetSelection;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
P: TPoint;
W, H: Single;
begin
bm32 := TBitmap32.Create;
bm32.SetSize(800,600);
with ImgView do
begin
Selection := nil;
Layers.Clear;
Scale := 1;
Bitmap.SetSize(800, 600);
Bitmap.Clear(clWhite32);
end;
B := TBitmapLayer.Create(ImgView.Layers);
with B do
try
Bitmap.DrawMode := dmBlend;
B.Bitmap.SetSize(800,600);
with ImgView.Bitmap do Location := GR32.FloatRect(0, 0, 800, 600);
Scaled := True;
OnMouseDown := LayerMouseDown;
OnMouseUp := LayerMouseUp;
OnMouseMove := LayerMouseMove;
OnPaint := LayerOnPaint;
except
Free;
raise;
end;
FDrawingLine := false;
end;
procedure TForm1.AddLineToLayer;
begin
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm1.SwapBuffers32;
begin
// BitBlt(imgView.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,bm32.Canvas.Handle, 0, 0, SRCCOPY);
BitBlt(B.Bitmap.Canvas.Handle, 0, 0, ClientWidth, ClientHeight,bm32.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TForm1.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X, Y);
FDrawingLine := true;
end;
procedure TForm1.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
FDrawingLine := false;
FEndPoint := Point(X, Y);
AddLineToLayer;
SwapBuffers32;
end;
procedure TForm1.LayerMouseMove(Sender: TObject; Shift: TShiftState;X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
ImgView.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
ImgView.Canvas.LineTo(X, Y);
end;
end;
procedure TForm1.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm1.SetSelection(Value: TPositionedLayer);
begin
if Value <> FSelection then
begin
FSelection := Value;
end;
end;
Now, no more Canvas errors, but the mouse-move lines stay drawn... The solution must be in the BitBlt function (swapbuffers32). Any ideas?