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

Question

I have got a form with a TImage on it. That TImage is set to Align=alClient, Stretch=True, Proportional=True and Center=True.

At runtime I load a bitmap into that TImage. It gets displayed a bit smaller than the original size but without distortion, as I expect it.

Now I want to get the coordinates of the pixel under the mouse when I press the Mouse button. This is the code assigned to 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;

(This is just testing code to see where the mouse click ends up. I know that using the Pixels property is very slow but it was the easiest way to make the affected pixels visible.)

This would work fine if all of these flags were set to false, but because the bitmap is shrunk to match the window, the pixels appear moved to the left and up.

I know that I need to adjust the coordinates, but how do I do it? Is there RTL/VCL support for that? Something like a CalcStretched method of the TImage (I couldn't find it but maybe I just overlooked it). Or do I really have to program the calculation myself?

(I can't believe that Google didn't find a ready made solution for this. This must have been a commonly encountered problem for decades.)

Answer 1

Well, you only need a few subtractions and divisions:

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;

Now:

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;