delphi - FireMonkey - 在 Windows 中绘制 1 像素线而不进行抗锯齿

Question

我没有成功尝试绘制 1 像素线。我尝试将表单中的 Quality 参数设置为所有三个可用选项，但这不会改变结果:始终得到一条具有抗锯齿功能的线。相反，tRectangle 类会以某种方式绘制干净的 1 像素宽度边框，这意味着可以禁用抗锯齿模式。问题是如何。以下是我正在使用的代码示例:

procedure tMyLine.Paint;
begin
  with Canvas do begin
       Stroke.Cap       := Flat;
       Stroke.Color     := tAlphaColor.Blue;
       Stroke.Join      := Miter;
       Stroke.Kind      := Solid;
       Stroke.Thickness := 1;
       BeginScene;
         DrawLine (tPointF (10, 10), tPointF (100, 10), 1);
       EndScene;
  end;
end; 

厚度小于一也不起作用。

Answer 1

使用表单和油漆箱的这些设置(偏离默认值):(顺便说一句，对于 Delphi 10.1 Berlin，我没有安装 Tokyo)

object Form24: TForm24
  Left = 0
  Top = 0
  Caption = 'Form24'
  ClientHeight = 216
  ClientWidth = 311
  Quality = HighPerformance
  FormFactor.Width = 320
  FormFactor.Height = 480
  FormFactor.Devices = [Desktop]
  DesignerMasterStyle = 0
  object PaintBox1: TPaintBox
    Position.X = 8.000000000000000000
    Position.Y = 8.000000000000000000
    Size.Width = 200.000000000000000000
    Size.Height = 200.000000000000000000
    Size.PlatformDefault = False
    OnPaint = PaintBox1Paint
  end

注意:质量 = HighPerformance，而不是HighQuality

下面的代码

procedure TForm24.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
var
  a: integer;
begin
  Canvas.BeginScene;
  try
    Canvas.Stroke.Color := TAlphaColorRec.Black;
    Canvas.Stroke.Kind := TBrushKind.Solid;
    Canvas.Stroke.Dash := TStrokeDash.solid;

    for a := 0 to 10 do
      Canvas.DrawLine(PointF(a * 20, 0), PointF(a * 20, 200), 1);

    for a := 0 to 10 do
      Canvas.DrawLine(PointF(0, a * 20 + 0), PointF(200, a * 20), 1);


    Canvas.DrawLine(PointF(0, 0), PointF(200, 200), 1);
    Canvas.DrawEllipse(RectF(5, 5, 195, 195), 1);

    Canvas.Stroke.Dash := TStrokeDash.Solid;
    Canvas.Stroke.Color := TAlphaColorRec.Red;
    Canvas.DrawRect(RectF(5, 5, 195, 195), 0, 0, [], 1);
  finally
    Canvas.EndScene;
  end;
end;

产生这个结果