Delphi :绘制高分辨率的圆弧

t30tvxxf  于 2023-05-28  发布在  其他
关注(0)|答案(4)|浏览(258)

我需要在 Delphi 中开发一个循环进度条,我不能使用第三方组件(公司政策)。我用画布,画一个弧线,这是工程罚款,但图像是在一个非常低的分辨率。有可能提高画布绘制的分辨率吗?
代码示例:

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;

结果:

我愿意听取其他解决办法的建议。

7fyelxc5

7fyelxc51#

如果不允许使用任何具有抗锯齿功能的第三方图形库,请考虑使用GDI+,它包含在Windows中, Delphi 有一个 Package 器。

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;

qncylg1j

qncylg1j2#

不确定Direct2D是否已经存在于 Delphi 2007中,但使用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;
af7jpaap

af7jpaap3#

一个非常简单的解决方案是在临时位图上以更高的分辨率(如1.5x或2x)绘制圆,然后将其调整为您的分辨率(因为调整大小过程将向圆添加抗锯齿),最后直接将此位图绘制到画布上。实际上,许多算法都是这样工作来添加抗锯齿。

vhmi4jdf

vhmi4jdf4#

您可以使用以下单元(正在进行中)您所需要做的就是将其添加到您的“uses”中,并且支持的TCanvas操作将转换为GDI+“魔术”是由TCanvas类助手完成的,它覆盖了所支持的函数:椭圆、多边形、多段线、线到、圆弧、Angular 圆弧

unit uAntiAliasedCanvas;

(*
Usage:
  Just include this unit in the "Uses" to turn AntiAliasing ON for the supported
  functions.

  use
    canvas.setAntiAliasing(boolean);
    to turn it off when needed

*)

interface
uses Graphics, types, UITypes, GdiPlus;

type TAntiAliasedCanvas = class helper for TCanvas
  private
    class var penPos : TPoint;
    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);
    procedure MoveTo(x,y : integer);
    procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
    procedure AngleArc(X, Y: Integer; Radius: Cardinal; StartAngle, SweepAngle: Single);
    class procedure setAntiAliasing(value : boolean);
end;

implementation

{ TAntiAliasedCanvas }

uses math, WinAPI.Windows, Direct2D, D2D1;

procedure TAntiAliasedCanvas.AngleArc(X, Y: Integer; radius: Cardinal;
  StartAngle, SweepAngle: Single);
begin
  if antiAliased then
    Graphics.DrawArc(pen, X-radius, Y-radius, radius*2, radius*2, -StartAngle, -SweepAngle)
  else
    inherited AngleArc(X, Y, Radius, StartAngle, SweepAngle)
end;

procedure TAntiAliasedCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
  var
    startAngle, toAngle, sweepAngle : single;
    R : TRect;
    C : TPoint;
begin
  if antiAliased then
    begin
      R := Rect(X1, Y1,x2,y2);
      R.NormalizeRect;
      C := R.CenterPoint;
      startAngle := math.RadToDeg(math.ArcTan2(y3-C.Y, X3-C.X));
      if startAngle < 0 then startAngle := startAngle + 360;
      toAngle := math.RadToDeg(math.ArcTan2(y4-C.Y, X4-C.X));
      if toAngle < 0 then toAngle := toAngle + 360;
      sweepAngle := -(toAngle - startAngle);
      if sweepAngle < 0 then sweepAngle := sweepAngle + 360;

      Graphics.DrawArc(pen,R.Left,R.Top, R.Width, R.Height, startAngle, -sweepAngle)
    end
  else
    inherited Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4)

end;

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
      if (inherited Brush).style <> bsClear then
        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
  begin
    graphics.DrawLine(pen, penPos.X, penPos.Y, X, Y);
    moveTo(x,y)
  end
  else
    inherited lineTo(x,y)
end;

procedure TAntiAliasedCanvas.MoveTo(x, y: integer);
begin
  penPos.X := x;
  penPos.Y := y;
  inherited moveTo(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
  assert(length(points)>0);
  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);
  case (inherited pen).style of
    psSolid        :  result.DashStyle :=  TGPDashStyle.DashStyleSolid;
    psDash         :  result.DashStyle :=  TGPDashStyle.DashStyleDash;
    psDot          :  result.DashStyle :=  TGPDashStyle.DashStyleDot;
    psDashDot      :  result.DashStyle :=  TGPDashStyle.DashStyleDashDot;
    psDashDotDot   :  result.DashStyle :=  TGPDashStyle.DashStyleDashDotDot;
  end;
  result.DashOffset
end;

procedure TAntiAliasedCanvas.Polygon(const Points: array of TPoint);
  var
    aPath : TGPGraphicsPath;
    aPen : IGPPen;
begin
  if length(points) = 0 then exit;

  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 length(points) = 0 then exit;

  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.

相关问题