CODEWITHSUNDEEP
delphi
grant1842
grant1842

Reputation: 367

Zoom out issue. Not zooming out to blow up the image

I was looking at this great example code here on SO Graphics32: Pan with mouse-drag, zoom to mouse cursor with mouse wheel

I am using Delphi Community on win 10 OS. I run the program and the zoom will zoom in, but when I zoom out it goes to the images regular size and doesn't blow up the image .

procedure TForm3.FormCreate(Sender: TObject);
begin
  DoubleBuffered := True;
  Image.Picture.LoadFromFile('C:\PASCHEMATIC.TIFF');
  Image.Stretch := True;
  Image.Height := Round(Image.Width * Image.Picture.Height / 
    Image.Picture.Width);
  FOrgImgBounds := Image.BoundsRect;
end;

procedure TForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    if FDragging then
    Image.SetBounds(X - FFrom.X, Y - FFrom.Y, Image.Width, Image.Height);
end;

procedure TForm3.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Image.Enabled := True;
  FDragging := False;
end;

procedure TForm3.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
const
  ZoomFactor: array[Boolean] of Single = (0.9, 1.1);
var
  R: TRect;
begin
  MousePos := Image.ScreenToClient(MousePos);
  with Image, MousePos do
  if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
  (Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
  ((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
  begin
    R := BoundsRect;
    R.Left := Left + X - Round(ZoomFactor[WheelDelta > 0] * X);
    R.Top := Top + Y - Round(ZoomFactor[WheelDelta > 0] * Y);
    R.Right := R.Left + Round(ZoomFactor[WheelDelta > 0] * Width);
    R.Bottom := R.Top + Round(ZoomFactor[WheelDelta > 0] * Height);
    BoundsRect := R;
    Handled := True;
  end;
end;

procedure TForm3.ImageDblClick(Sender: TObject);
begin
  Image.BoundsRect := FOrgImgBounds;
end;

procedure TForm3.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (ssDouble in Shift) then
  begin
    FDragging := True;
    Image.Enabled := False;
    FFrom := Point(X, Y);
    MouseCapture := True;
  end;
end;

The question is how to get the image to zoom out more to blow up the image?

I have played around with the ZoomFactor values. Seems I have to zoom in before it will zoom out.

Upvotes: 0

Views: 398

Answers (1)

Tom Brunberg
Tom Brunberg

Reputation: 21045

First, a definition: zoom in. So, your question is probably How to zoom in, in order to magnify the image? Or, why doesn't the image zoom in?

The answer is in the FormMouseWheel procedure:

with Image, MousePos do
  if PtInRect(ClientRect, MousePos) and ((WheelDelta > 0) and
  (Height < Self.ClientHeight) and (Width < Self.ClientWidth)) or
  ((WheelDelta < 0) and (Height > 20) and (Width > 20)) then
  begin
    ...

which also reveals the trap of using with ...: it can be hard to see what objects are actually referred to in the code:

(Height < Self.ClientHeight) 
// Height refers to Image.Height, because it is closer in
// scope (because of the with clause,) than e.g. the form,
// which also has an Height property
// Self.ClientHeight refers to Form.ClientHeight because
// Self refers to the object who's method is running

and the same for

(Width < Self.ClientWidth)
// Width refers to Image.Width and Self.ClientWidth refers to Form.ClientWidth

So, the answer to your question is that the image can not become bigger than either extent of the form because of constraints applied in the code.

To remove that constraint, remove 

and (Height < Self.ClientHeight) and (Width < Self.ClientWidth)

from the FormMouseWheel() procedure.

Removing those conditions will allow the Image to grow bigger than the form and thereby also the image it contains. At some point, there will be other conditions, like e.g. memory constraints, kicking in.

Upvotes: 2

Related Questions