Zoom canvas area in Delphi

Question

I making something that looks like Paint in Delphi. I found how to make zoom function:

procedure SetCanvasZoomFactor(Canvas: TCanvas; AZoomFactor: Integer);
var
  i: Integer;
begin
  if AZoomFactor = 100 then
    SetMapMode(Canvas.Handle, MM_TEXT)
  else
  begin
    SetMapMode(Canvas.Handle, MM_ISOTROPIC);
    SetWindowExtEx(Canvas.Handle, AZoomFactor, AZoomFactor, nil);
    SetViewportExtEx(Canvas.Handle, 100, 100, nil);
  end;
end;



procedure TMainForm.btnZoomPlusClick(Sender: TObject);
var
  bitmap: TBitmap;
begin 

  bitmap := TBitmap.Create;
  if(zoomVal < 1000) then
      zoomVal:=zoomVal+zoomConst; //zoomVal = 100 by default; zoomConst = 150;
  try
    bitmap.Assign(MainForm.imgMain.Picture.Bitmap);
    SetCanvasZoomFactor(bitmap.Canvas, zoomVal);
    Canvas.Draw(MainForm.imgMain.Left,MainForm.imgMain.Top, bitmap); 
  finally
    bitmap.Free
  end;
end;

But, the problem is - it zooms only upper left region of image.

Example before zoom: after zoom:

I want to be able to move through all picture area, even after zoom. How can I make this?

Unexacting

Here is an animated zoom selector and here is how to make animated panning. – Palaeontography

@Palaeontography holy delphi, it's not as easy as I thought! Well, if there are no other way to make such zoom, I will use such solution – Unexacting

It doesn't have to be so complex. There are used smooth animations there. It looks and feels nice to work with such control, but if you don't need animations, wait for an easier solution ;-) – Palaeontography

@Palaeontography well, yeah, actually i don't need smooth animation or something like that. At least right now. But thanks for the links! – Unexacting

Answer 1

You can use SetWorldTransform for every DC. An example implementation for could look like this:

Procedure SetCanvasZoomAndRotation(ACanvas: TCanvas; Zoom: Double;
  Angle: Double; CenterpointX, CenterpointY: Double);
var
  form: tagXFORM;
  rAngle: Double;
begin
  rAngle := DegToRad(Angle);
  SetGraphicsMode(ACanvas.Handle, GM_ADVANCED);
  SetMapMode(ACanvas.Handle, MM_ANISOTROPIC);
  form.eM11 := Zoom * Cos(rAngle);
  form.eM12 := Zoom * Sin(rAngle);
  form.eM21 := Zoom * (-Sin(rAngle));
  form.eM22 := Zoom * Cos(rAngle);
  form.eDx := CenterpointX;
  form.eDy := CenterpointY;
  SetWorldTransform(ACanvas.Handle, form);
end;

Procedure ResetCanvas(ACanvas: TCanvas);
begin
  SetCanvasZoomAndRotation(ACanvas, 1, 0, 0, 0);
end;

You might define Zoom, X Y Offest and rotation for the desired Canvas before painting. In your case you would choose a Zoom, paint to canvas and on scrolling in/decrease the value for X and/or Y and call the procedure with the same zoom again and paint your graphic.

EDIT To show how to use the procedure. This code

procedure TForm2.PaintBox1Paint(Sender: TObject);
var
  i, w, h: Integer;
  C: TCanvas;
begin
  C := TPaintBox(Sender).Canvas;
  w := TPaintBox(Sender).Width;
  h := TPaintBox(Sender).Height;
  for i := 0 to 9 do
  begin
    SetCanvasZoomAndRotation(C, 1 + i / 5, i * 36, w div 2, h div 2);
    C.Draw(0, 0, Image1.Picture.Graphic);
    C.Brush.Style := bsClear;
    C.TextOut(50, 0, Format('Hi this is an example %d', [i]));
  end;
end;

is used to display following result:

As response to your comment, how to use it with trackbars, you implement something like

procedure TForm2.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
end;

procedure TForm2.PaintBox1Paint(Sender: TObject);
var             // a Paintbox aligned alClient
  C:TCanvas;
begin
  TrackBarHorz.Max := Round(Image1.Picture.Graphic.Width * SpinEditZoomInPercent.Value / 100 - TPaintBox(Sender).Width);
  TrackBarVert.Max := Round(Image1.Picture.Graphic.Height * SpinEditZoomInPercent.Value / 100 - TPaintBox(Sender).Height);
  C := TPaintBox(Sender).Canvas;
  SetCanvasZoomAndRotation(c , SpinEditZoomInPercent.Value / 100, 0
                           , - TrackBarHorz.Position
                           , - TrackBarVert.Position);
  C.Draw(0,0,Image1.Picture.Graphic);
end;

procedure TForm2.SpinEditZoomInPercentChange(Sender: TObject);
begin
   PaintBox1.Invalidate;
end;

procedure TForm2.BothTrackbarsEvent(Sender: TObject);
begin
   PaintBox1.Invalidate;
end;

Puck

oh, thank you! I tried to use it like that but it's not working such way (I used trackbar because with it easy to check what changes) heres the code pastebin.com/X4umbmTX What I've done wrong? – Unexacting

Oh, thanks so much! But is it possible to use it with TImage, not TPaintBox? – Unexacting

You may use it with any Canvas (even Printer) if you use TImage you will have to clear the contained Bitmap (e.g. by Image1.Picture.Bitmap := nil) before painting again if the new drawn Graphic will not cover the whole Image, otherwise you might find a tiny bitmap draw over a before draw "bigger" one. Just play around, you will find best way for your demands, depending on the purpose. – Puck