Screen Graphics

Make a simple Image Zoomer in 5 minutes!

Zooming is kind of fun! Here is a 5 minute image zoom tutorial with mouse scroll fun!

We have 2 nifty events named OnMouseWheelUp and OnMouseWheelDown to tell when the user scrolled his mouse wheel.

Zooming is basically stretching the image to place it in a bigger area than the original. then the image looks bigger. We can use StretchDraw for this.

We can combine these 2 and you will be seeing a result before you know it!

Tutorial

Start Lazarus.

Create a new Application Project (Project -> New Project -> Application -> OK).

Draw a TImage (from Additional tab). Set a picture of your choice as its Picture property.

Draw a TScrollBar. Set its HorzScrollbar -> Tracking and VertScrollbar -> Tracking property to True.

Draw a TPaintbox inside the TScrollbox (start drawing from inside the TScrollbox to achieve this). Place it in the most top left position (or set Top to 0, Left to 0).

Now switch to F12 to go to Code View. Add the following line just under the line TForm1 = class(TForm):

1
procedure DrawImage;

Put your cursor on the line and press Ctrl+Shift+C. This should elaborate the procedure automatically for you to write something in it. Write something like this:

1
2
3
4
5
6
7
8
9
procedure TForm1.DrawImage;
var
  ImageRect: TRect;
begin
  ImageRect := Rect(0,0,(Image1.Picture.Width * ScaleFactor), (Image1.Picture.Height * ScaleFactor) );
  PaintBox1.Width := ImageRect.Right;
  PaintBox1.Height := ImageRect.Bottom;
  PaintBox1.Canvas.StretchDraw(ImageRect, image1.Picture.Bitmap);
end;

Just under the Form1: TForm1; line, insert this code:

1
  ScaleFactor:integer;

Now switch to Form View (F12). Double click the form and enter:

1
2
3
4
procedure TForm1.FormCreate(Sender: TObject);
begin
  ScaleFactor:=1;
end;

We will set the default ScaleFactor to 1 to show the image as is at first when it loads. Then we manipulate the value to enlarge the image.

Now go to Form View (F12). Select the TPaintBox. Go to Events and click the [...] button next to ScrollWheelDown and enter:

1
2
3
4
5
6
7
8
9
procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  // we don't want it to be less than 1
  if ScaleFactor > 1 then begin
     ScaleFactor:=ScaleFactor-1;
     DrawImage;
  end;
end;

Now again Go to Events and click the […] button next to ScrollWheelUp and enter:

1
2
3
4
5
6
7
8
9
procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  // we allow 50 times zoom!
  if ScaleFactor < 50 then begin
     ScaleFactor:=ScaleFactor+1;
     DrawImage;
  end;
end;

These two above will control the mouse wheel scroll events. When the Wheel will scroll up it will zoom in and zoom out when scrolling down.

Lastly, select PaintBox1, go to Events once again. Click the […] button next to OnPaint. Now enter:

1
2
3
4
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DrawImage;
end;

This simple code will update the image when it is needed. Especially when it needs redraw (resize the window, minimize/restore, hide/show the window etc.)

Run it!

Now run the project (F9 or Run -> Run).

This would show your shiny new form on your screen ready to be played with.

Image zoom in zoom out made with Lazarus in 5 minutes!

This is just a quick example of how to use mouse scroll and image stretching in simple code. You can enhance it if you like.

Thanks to Achmad Davit for requesting this.

Ref:

Downloads

You can download the source code for the tutorial project and executable/EXE files from the links below:

Related posts

See comments for this article