Delphi Graphics32 рисует прозрачный эллипс на слое

Question

Delphi Graphics32 рисует прозрачный эллипс на слое

Я хочу иметь возможность рисовать пустой эллипс на прозрачном слое в 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, предыдущий круг очищается, но новый эллипс также заполняется белым (как на этом изображении)

Также, если вы попытаетесь сделать больше эллипсов один за другим, и onTop более старых, вы заметите, что будут следы эллипсов onMouseMove, как на этом изображении:

Так что должно быть что-то, что мне не хватает с этим кодом.

Пожалуйста, помогите мне решить это.

5

delphi delphi-xe graphics32

Источник

user1137313 17 фев '15 в 20:45

2 ответа

Другие вопросы по тегам delphi delphi-xe graphics32

user2757879 18 фев '15 в 14:04 2015-02-18 14:04 · Answer 1 · 2015-02-18 14:04

Если вы используете последний код GR32 из ствола, вы также можете использовать этот фрагмент кода для определения эллипса

Points := Ellipse(Center.X, Center.Y, Radius.X, Radius.Y);

или даже проще

Points := Ellipse(Center, Radius);

где Points определяется как

Points: TArrayOfFloatPoint;

Это создает многоугольник эллипса с центром в Center и независимый радиус x и y, определенный как Radius,

Если у вас есть многоугольник, вы можете отобразить его, используя любой векторный рендер. Например, вы можете использовать встроенный VPR рендер с

PolygonFS(Bitmap, Points, SomeColor32);

сделать заполненный эллипс.

Однако, если вы хотите, чтобы кадр отображался, вы можете использовать это

PolylineFS(Bitmap, Points, AnotherColor32, True, PenWidth);

Параметры для этого

Bitmap = TBitmap32 экземпляр для отображения
Точки = Точки многоугольника (как определено выше)
AnotherColor32 = цвет, который используется для рендеринга
True = закрыть многоугольник (иначе ваш эллипс будет иметь разрыв между начальной и конечной точкой
PenWidth = ширина кадра

Если вам нравится, вы также можете сделать это в один звонок, как

PolylineFS(Bitmap, Ellipse(Center, Radius), AnotherColor32, True, PenWidth);

Чтобы получить произвольный (повернутый) эллипс, вам нужно преобразовать многоугольник перед рендерингом. Ты можешь использовать

TransformPolygon(Points, Transformation);

за это, которое получает TTransformation экземпляр как второй параметр. Это может включать в себя все общие операции, такие как поворот, наклон, масштабирование и перевод.

Если вы используете это, вы также можете начать с более простого круга в качестве ввода многоугольника и масштабировать круг, чтобы получить эллипс.

Приведенный выше код делает необходимым включение модулей GR32_VectorUtils, GR32_Polygons в ваш проект, например

uses
  GR32_VectorUtils, GR32_Polygons;

Преимущество состоит в том, что вы не полагаетесь на GDI для рендеринга, и, таким образом, вы можете выбрать рендерер из доступного рендерера из GR32. Некоторые включают эффект, подобный ClearType, и улучшают видимость на ЖК-экранах. Не говоря уже о качестве сглаживания и возможности управления гаммой для рендеринга.

user1137313 17 фев '15 в 22:39 2015-02-17 22:39 · Answer 2 · 2015-02-17 22:39

Поэтому при рисовании круга / эллипса установите цвет кисти равным 0, например:

procedure TForm5.AddCircleToLayer;
begin
  bm32.Canvas.Pen.Color := pencolor;
  bm32.Canvas.Pen.Width := penwidth;
  bm32.Canvas.Brush.Color := 0; // this here does the magic
  bm32.Canvas.MoveTo(FStartPoint.X, FStartPoint.Y);
  bm32.Canvas.Ellipse(FStartPoint.X, FStartPoint.Y,FEndPoint.X, FEndPoint.Y);
  SwapBuffers32;
end;

Также сделайте то же самое в событии LayerMouseMove