Delphi: 以高分辨率绘制圆弧
Delphi: Draw a Arc in high resolution
我需要在delphi2007开发一个循环进度条，我不能使用第三方组件（公司政策）。
我正在使用 Canvas，绘制弧形，效果很好，但图像的分辨率非常低。可以提高 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;
结果：
我愿意接受其他解决方案的建议。
如果不允许使用任何具有 anti-aliasing 可能性的 third-party 图形库，请考虑使用 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;
一个非常简单的解决方案是在临时位图上以更高的分辨率（例如 1.5x 或 2x）绘制您的圆圈，然后将其调整为您的分辨率（因为调整大小过程将为您的圆圈添加抗锯齿）和最后直接把这张位图绘制到canvas。事实上，许多算法都是这样添加抗锯齿的。
不确定 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;
您可以使用以下单元（进行中）
您需要做的就是将它添加到您的 "uses" 中，支持的 TCanvas 操作将转换为 GDI+
"magic" 由覆盖函数的 TCanvas class 助手完成
支持：椭圆、多边形、折线、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 [=10=]0000FF);
result := TGPColor.Create(
color and $FF,
(color and $FF00) shr 8,
(color and $FF0000) shr 16)
end;
begin
TCanvas.setAntiAliasing(true)
end.
我需要在delphi2007开发一个循环进度条，我不能使用第三方组件（公司政策）。 我正在使用 Canvas，绘制弧形，效果很好，但图像的分辨率非常低。可以提高 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;
结果：
我愿意接受其他解决方案的建议。
如果不允许使用任何具有 anti-aliasing 可能性的 third-party 图形库，请考虑使用 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;
一个非常简单的解决方案是在临时位图上以更高的分辨率（例如 1.5x 或 2x）绘制您的圆圈，然后将其调整为您的分辨率（因为调整大小过程将为您的圆圈添加抗锯齿）和最后直接把这张位图绘制到canvas。事实上，许多算法都是这样添加抗锯齿的。
不确定 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;
您可以使用以下单元（进行中） 您需要做的就是将它添加到您的 "uses" 中，支持的 TCanvas 操作将转换为 GDI+ "magic" 由覆盖函数的 TCanvas class 助手完成 支持：椭圆、多边形、折线、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 [=10=]0000FF);
result := TGPColor.Create(
color and $FF,
(color and $FF00) shr 8,
(color and $FF0000) shr 16)
end;
begin
TCanvas.setAntiAliasing(true)
end.