delphi - 更改 bsB 对角线宽度和间隙

Question

我正在尝试在高 DPI 和标准 DPI 环境中生成一致的界面。我们有一个选择框，它使用如下所示的油漆:

theCanvas.Brush.style := bsBDiagonal;
theCanvas.pen.style := psClear;
theCanvas.brush.color := clBlue;

是否有任何方法可以更改 bsBDiagonal 绘制的线条宽度和线条之间的间隙，因为这些不考虑显示器的 DPI。具有高 DPI 系统的用户会看到非常细的对角线，这些对角线非常靠近，而具有常规 DPI 显示器的用户会看到相距较远且较宽的绘画。

例如。左侧是用户在常规 DPI 显示器上看到的内容，右侧是等效的高 DPI。

Answer 1

填充画笔始终在图形设备单位中工作。我以前在打印机上遇到过这个问题，并做了这个程序:

//Fillstep depends linearly on DPI

procedure PrintHatchPolygon(Canvas: TCanvas; Pts: array of TPoint;
  FillStep: Integer);
var
  ClipRgn: HRGN;
  r: TRect;
  i, MaxSize, OldPenColor, HatchStyle: Integer;

  procedure Line(X1, Y1, X2, Y2: Integer);
  begin
    Canvas.MoveTo(X1, Y1);
    Canvas.LineTo(X2, Y2);
  end;

begin
  case Canvas.Brush.Style of
    bsVertical:
      HatchStyle := 1;
    bsHorizontal:
      HatchStyle := 2;
    bsFDiagonal:
      HatchStyle := 4;
    bsBDiagonal:
      HatchStyle := 8;
    bsCross:
      HatchStyle := 3;
    bsDiagCross:
      HatchStyle := 12;
  else
    HatchStyle := 0;
  end;
  OldPenColor := Canvas.Pen.Color;
  Canvas.Pen.Color := Canvas.Brush.Color;
  ClipRgn := CreatePolygonRgn(Pts, High(Pts) + 1, ALTERNATE);
  GetRgnBox(ClipRgn, r);
  MaxSize := r.Bottom - r.Top;
  if MaxSize < (r.Right - r.Left) then
    MaxSize := r.Right - r.Left;
  SelectClipRgn(Canvas.Handle, ClipRgn);
  with r do begin
    if (HatchStyle and 1) > 0 then
      for i := 1 to (r.Right - r.Left) div FillStep do
        Line(Left + i * FillStep, Top, Left + i * FillStep, Bottom);
    if (HatchStyle and 2) > 0 then
      for i := 1 to (r.Bottom - r.Top) div FillStep do
        Line(Left, Top + i * FillStep, Right, Top + i * FillStep);

    //to equalize step
    //FillStep := 1414 * FillStep div 1000;

    if (HatchStyle and 4) > 0 then
      for i := 1 to 2 * MaxSize div FillStep do
        Line(Left, Bottom - i * FillStep, Left + i * FillStep, Bottom);
    if (HatchStyle and 8) > 0 then
      for i := 1 to 2 * MaxSize div FillStep do
        Line(Left, Top + i * FillStep, Left + i * FillStep, Top);
  end;
  SelectClipRgn(Canvas.Handle, 0);
  DeleteObject(ClipRgn);
  Canvas.Pen.Color := OldPenColor;
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  P: array [0 .. 2] of TPoint;
begin
  P[0] := Point(10, 10);
  P[1] := Point(100, 10);
  P[2] := Point(10, 200);
  Canvas.Brush.Style := bsDiagCross;
  Canvas.Brush.Color := clRed;

  //value 8 for usual monitor dpi (72?)
  //value 60 for 600dpi printer
  PrintHatchPolygon(Canvas, P, 8);
  Canvas.Brush.Style := bsClear;
  Canvas.Polygon(P);
end;