使用 Stretch 在 TImage 中获取鼠标下方的像素。 Proportional 和 Center 都设置为 true

Question

我有一个带有 TImage 的表格。 TImage 设置为 Align=alClient、Stretch=True、Proportional=True 和 Center=True。

在运行时，我将位图加载到该 TImage 中。它显示的比原来的尺寸小一点，但没有失真，正如我所料。

现在我想获取按下鼠标键时鼠标下方像素点的坐标。这是分配给 im_Input.OnMouseDown:

的代码

procedure Tf_ColorAdjustment.im_InputMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  im_Input.Picture.Bitmap.Canvas.Pixels[X - 1, Y - 1] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X - 1, Y] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X - 1, Y + 1] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X, Y - 1] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X, Y] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X, Y + 1] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X + 1, Y - 1] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X + 1, Y] := clYellow;
  im_Input.Picture.Bitmap.Canvas.Pixels[X + 1, Y + 1] := clYellow;
end;

（这只是测试代码以查看鼠标点击结束的位置。我知道使用像素属性非常慢，但这是使受影响的像素可见的最简单方法。）

如果所有这些标志都设置为 false，这会很好地工作，但是因为位图被缩小以匹配 window，像素看起来向左和向上移动。

我知道我需要调整坐标，但是我该怎么做呢？ RTL/VCL 支持吗？类似于 TImage 的 CalcStretched 方法（我找不到它，但也许我只是忽略了它）。或者我真的必须自己编写计算程序吗？

（我不敢相信 Google 没有为此找到现成的解决方案。这一定是几十年来普遍遇到的问题。）

Answer 1

好吧，你只需要几个减法和除法：

function TForm1.ClientToBitmap(const P: TPoint): TPoint;
var
  cW, cH: Integer;       // width and height of control
  bW, bH: Integer;       // width and height of bitmap
  Origin: TPointF;       // top-left pixel of bitmap in the control
  ZoomW, ZoomH: Double;  // required zoom factor to make bitmap fit horisontally or vertically
  Zoom: Double;          // zoom factor
begin

  cW := Image1.Width;
  cH := Image1.Height;
  bW := Image1.Picture.Bitmap.Width;
  bH := Image1.Picture.Bitmap.Height;

  ZoomW := cW/bW;
  ZoomH := cH/bH;
  Zoom := Min(ZoomW, ZoomH);

  Origin.X := (cW - bW*Zoom) / 2;
  Origin.Y := (cH - bH*Zoom) / 2;

  Result.X := Round((P.X - Origin.X) / Zoom);
  Result.Y := Round((P.Y - Origin.Y) / Zoom);

end;

现在：

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  with ClientToBitmap(Point(X, Y)) do
  begin
    Image1.Picture.Bitmap.Canvas.Pixels[X - 1, Y - 1] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X - 1, Y] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X - 1, Y + 1] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X, Y - 1] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X, Y] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X, Y + 1] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X + 1, Y - 1] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X + 1, Y] := clBlack;
    Image1.Picture.Bitmap.Canvas.Pixels[X + 1, Y + 1] := clBlack;
  end;
end;

使用 Stretch 在 TImage 中获取鼠标下方的像素。 Proportional 和 Center 都设置为 true

Getting the pixel under the mouse in TImage with Stretch. Proportional and Center all set to true

delphi

vcl