Я хочу иметь возможность рисовать пустой эллипс на прозрачном слое в ImgView32. Любая идея, как это сделать? Пока все, о чем я могу думать, это:
BL := TBitmapLayer.Create(ImgView.Layers);
BL.Bitmap.DrawMode := dmTransparent;
BL.Bitmap.SetSize(imwidth,imheight);
BL.Bitmap.Canvas.Pen.Width := penwidth;
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Location := GR32.FloatRect(0, 0, imwidth, imheight);
BL.Scaled := False;
BL.OnMouseDown := LayerMouseDown;
BL.OnMouseUp := LayerMouseUp;
BL.OnMouseMove := LayerMouseMove;
BL.OnPaint := LayerOnPaint;
...
BL.Bitmap.Canvas.Pen.Color := clBlue;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);
Начальная и конечная точки получаются в событиях мыши.
На самом деле я пытаюсь нарисовать динамический эллипс (по событиям мыши). Таким образом, задействованы события onMouseDown (LayerMouseDown), onMouseUp (LayerMouseUp) и OnMouseMove (LayerMouseMove). В качестве справки проверьте этот вопрос, он касается динамического рисования линии. Я хочу сделать то же самое, но с эллипсами вместо линий.
Итак, вместо AddLineToLayer у меня есть процедура AddCircleToLayer. Теперь события выглядят так:
procedure TForm5.SwapBuffers32;
begin
TransparentBlt(
BL.Bitmap.Canvas.Handle, 0, 0, BL.Bitmap.Width, BL.Bitmap.Height,
bm32.Canvas.Handle, 0, 0, bm32.Width, bm32.Height, clWhite);
end;
procedure TForm5.ImgViewResize(Sender: TObject);
begin
OffsX := (ImgView.ClientWidth - imwidth) div 2;
OffsY := (ImgView.ClientHeight - imheight) div 2;
BL.Location := GR32.FloatRect(OffsX, OffsY, imwidth+OffsX, imheight+OffsY);
end;
procedure TForm5.LayerMouseDown(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStartPoint := Point(X-OffsX, Y-OffsY);
FDrawingLine := true;
end;
procedure TForm5.LayerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if FDrawingLine then
begin
SwapBuffers32;
if RadioGroup1.ItemIndex=0 then
begin
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
BL.Bitmap.Canvas.LineTo(X-OffsX, Y-OffsY);
end
else
begin
BL.Bitmap.Canvas.Pen.Color := pencolor;
BL.Bitmap.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
SwapBuffers32;
BL.Bitmap.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,X-OffsX, Y-OffsY);
end;
end;
end;
procedure TForm5.LayerMouseUp(Sender: TObject; Buttons: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if RadioGroup1.ItemIndex=0 then
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddLineToLayer;
SwapBuffers32;
end
else
begin
FDrawingLine := false;
FEndPoint := Point(X-OffsX, Y-OffsY);
AddCircleToLayer;
SwapBuffers32;
end
end;
procedure TForm5.LayerOnPaint(Sender: TObject; Buffer: TBitmap32);
begin
SwapBuffers32;
end;
procedure TForm5.AddLineToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.LineTo(FEndPoint.X, FEndPoint.Y);
end;
procedure TForm5.AddCircleToLayer;
begin
bm32.Canvas.Pen.Color := pencolor;
bm32.Canvas.Pen.Width := penwidth;
bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
bm32.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);
SwapBuffers32;
end;
Но когда я использую этот код, круг (эллипс) заполняется белым (как на этом изображении) пока я не начну рисовать следующий эллипс (поэтому onMouseMove и onMouseUp эллипс заполняется). И только когда я делаю еще один onMouseDown, тогда предыдущий круг становится пустым, но новый эллипс также заполняется белым (как на этом изображении)
Также, если вы попытаетесь сделать больше эллипсов один за другим и поверх старых, вы заметите, что будут следы эллипсов onMouseMove, как на этом изображении:
Так что должно быть что-то, что мне не хватает в этом коде.
Пожалуйста, помогите мне решить эту проблему.