Delphi: Нарисуйте дугу в высоком разрешении

Question

Мне нужно разработать круговой индикатор выполнения в delphi 2007, я не могу использовать сторонние компоненты (политика компании). Я использую Canvas, рисуя дугу, это прекрасно работает, но изображение имеет очень низкое разрешение. Можно улучшить разрешение в рисовании холста?

Пример кода:

procedure TForm1.DrawPieSlice(const Canvas: TCanvas; const Center: TPoint; 
    const Radius: Integer; const StartDegrees, StopDegrees: Double); 
//Get it in http://delphidabbler.com/tips/148 
const 
    Offset = 90; 
var 
    X1, X2, X3, X4: Integer; 
    Y1, Y2, Y3, Y4: Integer; 
begin 
    X1 := Center.X - Radius; 
    Y1 := Center.Y - Radius; 
    X2 := Center.X + Radius; 
    Y2 := Center.Y + Radius; 
    X4 := Center.X + Round(Radius * Cos(DegToRad(Offset + StartDegrees))); 
    Y4 := Center.y - Round(Radius * Sin(DegToRad(Offset + StartDegrees))); 
    X3 := Center.X + Round(Radius * Cos(DegToRad(Offset + StopDegrees))); 
    Y3 := Center.y - Round(Radius * Sin(DegToRad(Offset + StopDegrees))); 
    Canvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4); 
end; 

procedure TForm1.SpinEdit1Change(Sender: TObject); 
var 
    Center: TPoint; 
    Bitmap: TBitmap; 
    Radius: Integer; 
    p: Pointer; 
begin 
    Label1.Caption:= SpinEdit1.Text+'%'; 
    Bitmap := TBitmap.Create; 
    try 
    Bitmap.Width := Image1.Width; 
    Bitmap.Height := Image1.Height; 
    Bitmap.PixelFormat := pf24bit; 
    Bitmap.HandleType := bmDIB; 
    Bitmap.ignorepalette := true; 
    Bitmap.Canvas.Brush.Color := clBlack; 
    Bitmap.Canvas.Pen.Color := clHighlight; 
    Bitmap.Canvas.Pen.Width := 10; 
    Center := Point(Bitmap.Width div 2, Bitmap.Height div 2); 
    Radius := 61; 
    DrawPieSlice(Bitmap.Canvas, Center, Radius,0,round(SpinEdit1.Value * -3.6)); 

    Image1.Picture.Graphic := Bitmap; 
    finally 
    Bitmap.Free; 
    end; 
end; 

Результат:

Я открыт для предложений для других решений.

Answer 1

Если вам не разрешено использовать стороннюю графическую библиотеку с возможностями сглаживания, рассмотрите возможность использования GDI +, включенного в Windows, и у Delphi есть обертка для нее.

uses 
    ..., GDIPAPI, GDIPOBJ, GDIPUTIL //included in Delphi standard modules 

var 
    graphics: TGPGraphics; 
    SolidPen: TGPPen; 
begin 
    graphics := TGPGraphics.Create(Canvas.Handle); 
    graphics.SetSmoothingMode(SmoothingModeAntiAlias); 
    SolidPen := TGPPen.Create(MakeColor(255, 0, 0, 255), 31); 
    SolidPen.SetStartCap(LineCapRound); 
    SolidPen.SetEndCap(LineCapRound); 
    graphics.DrawArc(SolidPen, 100, 100, 100, 100, 0, 270); 
    graphics.Free; 
    SolidPen.Free; 

Answer 2

очень простое решение было бы сделать свой круг с более высоким разрешением (например, 1,5 или 2 раза) на темп растрового изображения, а затем изменить его размер до вашего разрешения (потому что процесс изменения размера будет добавьте antialias к вашему кругу) и, наконец, нарисуйте непосредственно это растровое изображение на холсте. на самом деле это так, что многие алгоритмы работают, чтобы добавить антиалиасы.

Answer 3

Не уверен, что устройства Direct2D уже существуют в Delphi 2007, но это может быть лучший вариант использования Direct2D, поскольку он отображается с использованием графического процессора, а не центрального процессора.

uses Vcl.Direct2D, Winapi.D2D1; 

... 

var 
    D2DCanvas: TDirect2DCanvas; 
begin 
    if TDirect2DCanvas.Supported then 
    begin 
    D2DCanvas := TDirect2DCanvas.Create(PaintBox.Canvas, PaintBox.ClientRect); 
    try 
     D2DCanvas.RenderTarget.BeginDraw; 
     D2DCanvas.RenderTarget.SetAntialiasMode(D2D1_ANTIALIAS_MODE_PER_PRIMITIVE); 
     D2DCanvas.Pen.Color := TColors.Blue; 
     D2DCanvas.Pen.Width := 10; 
     D2DCanvas.Arc(100, 100, 200, 200, 100, 150, 150, 100); 
     D2DCanvas.RenderTarget.EndDraw; 
    finally 
     D2DCanvas.Free; 
    end; 
    end 
end;