delphicanvasvcldelphi-2007

Delphi: Draw a Arc in high resolution


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:

Sample

I am open to proposals for other solutions.


Solution

  • 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;
    

    enter image description here