Delphi: Draw a Arc in high resolution - delphi

Question

I need develop a circular progress bar in delphi 2007, I can't use third-party components (company policy).
I'm using a Canvas, drawing an arc, that's works fine, but the image is at a very low resolution. It's possible to improve the resolution in canvas drawing?
Code sample:
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;
Result:
I am open to proposals for other solutions.

Answer 1

If you are not allowed to use any third-party graphic library with anti-aliasing possibilities, consider using GDI+, which is included in Windows, and Delphi has a wrapper for it.
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

Not sure if Direct2D units already exist in Delphi 2007, but it maybe a better option to use Direct2D since it is rendered using GPU, not CPU.
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;

Answer 3

a very simple solution would be to draw your circle at a higher resolution (like 1.5x or 2x) on a temp bitmap and then resize it to your resolution (because the resize process will add antialias to your circle) and finally draw directly this bitmap to the canvas. in fact it's like this that many algorithm work to add antialias.

Answer 4

you may use the following unit (work in progress)
All you need to do is to add it to your "uses" and the supported TCanvas operations will be converted to GDI+
The "magic" is done by a TCanvas class helper that overrides the functions
supports: ellipse, polygon, polyline, lineTo
arc is not yet supported - because I did not need it so far...
unit uAntiAliasedCanvas;
interface
uses Graphics, types, UITypes, GdiPlus;
type TAntiAliasedCanvas = class helper for TCanvas
private
function Graphics : IGPGraphics;
function Pen : IGPPen;
function Brush: IGPBrush;
function path(const points : array of TPoint; close : boolean = false) : TGPGraphicsPath;
function TGPcolorFromVCLColor(color : TColor) : TGPColor;
private
class var antiAliased : boolean;
public
procedure Ellipse(X1, Y1, X2, Y2: Integer);
procedure Polyline(const Points: array of TPoint);
procedure Polygon(const Points: array of TPoint);
procedure lineTo(x,y : integer);
class procedure setAntiAliasing(value : boolean);
end;
implementation
{ TAntiAliasedCanvas }
uses WinAPI.Windows;
function TAntiAliasedCanvas.Brush: IGPBrush;
begin
result := TGPSolidBrush.Create(
TGPColor.Create(
TGPcolorFromVCLColor(
(inherited brush).color)));
end;
procedure TAntiAliasedCanvas.Ellipse(X1, Y1, X2, Y2: Integer);
begin
if antiAliased then
begin
Graphics.fillEllipse(brush, X1, Y1, 1+X2-X1, 1+Y2-Y1);
Graphics.drawEllipse(Pen, X1, Y1, 1+X2-X1, 1+Y2-Y1)
end
else
inherited Ellipse(X1, Y1, X2, Y2)
end;
function TAntiAliasedCanvas.Graphics: IGPGraphics;
begin
result := TGPGraphics.Create(Handle);
result.SmoothingMode := SmoothingModeAntiAlias
end;
procedure TAntiAliasedCanvas.lineTo(x, y: integer);
begin
if antiAliased then
graphics.DrawLine(pen, penPos.X, penPos.Y, X, Y)
else
inherited lineTo(x,y)
end;
function TAntiAliasedCanvas.path(const points: array of TPoint;
close : boolean = false): TGPGraphicsPath;
var
GPPoints: array of TGPPointF;
ptTypes : array of byte;
i : integer;
begin
setLength(GPPoints, length(points) + ord(close));
setLength(ptTypes, length(points) + ord(close));
for i := 0 to high(Points) + ord(close) do
with points[i mod length(points)] do
begin
GPPoints[i] := TGPPointF.Create(x,y);
ptTypes[i] := byte(PathPointTypeLine);
end;
result := TGPGraphicsPath.Create(GPPoints,ptTypes)
end;
function TAntiAliasedCanvas.pen: IGPpen;
begin
result := TGPpen.Create(
TGPColor.Create(
TGPcolorFromVCLColor(
(inherited pen).color)),
(inherited pen).width);
end;
procedure TAntiAliasedCanvas.Polygon(const Points: array of TPoint);
var
aPath : TGPGraphicsPath;
aPen : IGPPen;
begin
if antiAliased then
begin
aPath := path(points, true);
graphics.FillPath(brush, aPath);
aPen := pen();
aPen.SetLineJoin(LineJoinRound);
graphics.DrawPath(aPen, aPath);
end
else
inherited Polygon(points);
end;
procedure TAntiAliasedCanvas.Polyline(const Points: array of TPoint);
var
aPen : IGPPen;
begin
if antiAliased then
begin
aPen := pen();
aPen.SetLineJoin(LineJoinRound);
graphics.DrawPath(aPen, path(points))
end
else
inherited polyline(points)
end;
class procedure TAntiAliasedCanvas.setAntiAliasing(value: boolean);
begin
antiAliased := value
end;
function TAntiAliasedCanvas.TGPcolorFromVCLColor(color: TColor): TGPColor;
begin
if Color < 0 then
color := GetSysColor(Color and $000000FF);
result := TGPColor.Create(
color and $FF,
(color and $FF00) shr 8,
(color and $FF0000) shr 16)
end;
begin
TCanvas.setAntiAliasing(true)
end.