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

如果您不允许使用任何具有抗锯齿功能的第三方图形库，请考虑使用Windows中包含的GDI +，并且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.5x或2x）绘制圆圈，然后将其调整为您的分辨率（因为调整大小过程会为您的圆圈添加抗锯齿）并最终绘制直接这个位图到画布。实际上它是这样的，许多算法都可以添加抗锯齿。

Answer 3

不确定Delphi 2007中是否已经存在Direct2D单元，但它可能是使用Direct2D的更好选择，因为它是使用GPU而不是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 4

您可以使用以下单位（进行中）您需要做的就是将其添加到“使用”中，支持的TCanvas操作将转换为GDI + “魔术”由覆盖功能的TCanvas类帮助器完成支持：椭圆，多边形，折线，lineTo 尚不支持arc-因为到目前为止我还不需要它...

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.

德尔福：以高分辨率绘制弧形

4 个答案: