How to navigation image?

[barsoom]

I would like to havo something like the navigation map of TChart, but for an image. It is: To have a big image inside a scrollbox, and, in the same form, the same image as a thumbnail with a red box showing the portion of the image showed in the scrollbox (since the full-size image is bigger than the client size of the scrollbox. The idea is to allow the user, not only to know which section of the image is observing, but also to move the redbox windows to change the portion of the image showed in the scrollbox.

For the moment, what i have is a imag showed both at full size in side the scrollbox, and in a small panel close to it. I created a shape on top of the thumbail, and this is the code i have to calculate the size of the red window marking the visible area of the image, and its position.

I added a quick and dirty demo project to help you to understand what i want to do.

My first problem is the position, since i do not know how to know the coordinates of the iupperleft corner of the section of the image showed in the scrollbox.

This is the code and where i have the problem:

Code: Pascal  [Select][+][-]

1. procedure TForm1.RedBoxExecute(Sender: TObject);
2. var
3.   imagew: integer;  //Original image width at full size
4.   imageh: integer;  // Original image height  at full size
5.   windoww: integer; // frame width  (scrollbox)
6.   windowh: integer; // frame height  (scrollbox)
7.   thumbnailw: integer;  //map width: the same image but small outsize the scrollbox
8.   thumbnailh: integer;  //map height: the same image but small outsize the scrollbox
9.   redboxw: integer; // calculated redbox width
10.   redboxh: integer; // calculated redbox height
11.   imageX: integer;  // X coordinate of the upperleft pixel of the image showed in the scrollbox
12.   imageY: integer;  // Y coordinate of the upperleft pixel of the image showed in the scrollbox
13.   redboxX: integer; // Calculated left position of the shape
14.   redboxY: integer; // Calculated top position of the shape
15. begin
16.    imagew := image23.Picture.Bitmap.Width;
17.    imageh := image23.Picture.Bitmap.Height;
18.    windoww := scrollbox3.clientWidth;
19.    windowh := scrollbox3.clientHeight;
20.    thumbnailw := image21.Width;
21.    thumbnailh := image21.Height;
22.    redboxw := round((Thumbnailw*windoww) div imagew);
23.    redboxh := round((Thumbnailh*windowh)div imageh);
24.    shape1.Width := redboxw;
25.    shape1.Height := redboxh;
26.  
27.    imageX := scrollbox3.HorzScrollBar.ScrollPos;  <-- this is not correct at all
28.    imageY := scrollbox3.vertScrollBar.ScrollPos;   <-- this is not correct at all
29.    redboxX := round(( imagew*imageX) div thumbnailw);
30.    redboxY := round(( imageh*imageY) div thumbnailh);
31.    shape1.Left := redboxX;
32.    shape1.Top := redboxY;
33. end;

I know this code is not perfect, but it is my testing code to understand what i am doing before and fsolve problems before to do it more efficient and simple.


So the question now is: How could i know the coordinates of the upperleft pixel of the image showed in the scrollbox in any moment?

Thanks!

[loaded]

It is possible to make any transaction you want with a few changes.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. begin
3.   if openpicturedialog1.Execute then
4.      begin
5.        image1.Proportional:=false;  // added
6.        ScrollBox1.HorzScrollBar.Tracking:=true; // added
7.        ScrollBox1.VertScrollBar.Tracking:=true; // added
8.  
9.        image1.Picture.LoadFromFile(openpicturedialog1.FileName);
10.        image2.Picture.LoadFromFile(openpicturedialog1.FileName);
11.        RedBox.Execute;
12.      end;
13. end;
14.  
15. procedure TForm1.RedBoxExecute(Sender: TObject);
16. begin //modify ...
17.   Shape1.Width:=round(ScrollBox1.ClientWidth*(image1.Width/Image2.Picture.Width));
18.   Shape1.Height:=round(ScrollBox1.ClientHeight*(image1.Height/Image2.Picture.Height));
19.   Shape1.Left:=round(Scrollbox1.HorzScrollBar.ScrollPos*(image1.Width/Image2.Picture.Width));
20.   Shape1.Top:=round(Scrollbox1.VertScrollBar.ScrollPos*(image1.Height/Image2.Picture.Height));
21. end;
22.  
23.  
24.  

[barsoom]

Thanks @Loaded!

What simple!! Thanks so much!!

I added your correction to the example project, and it works great. I added panning option to the main image, and the redbox reflect the changes. To reduce the flickering i added this code on form creation:

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.   Form1.DoubleBuffered := True;
4.   Scrollbox1.DoubleBuffered:=True;
5. end;  

Next step (and problem) is to move the redbox on the thumbnail, and show on the main image the portion marked in the redbox.

To do that, i added onMoveup, onMousemove and onMouseMove actions:

Code: Pascal  [Select][+][-]

1. procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
2.   Shift: TShiftState; X, Y: Integer);
3. begin
4.   screen.cursor:=crHandPoint;
5. end;
6.  
7. procedure TForm1.Shape1MouseLeave(Sender: TObject);
8. begin
9.   Screen.cursor:=crDefault;
10. end;
11.  
12. procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
13.   Y: Integer);
14. var
15.   redboxX: integer;
16.   redboxY: integer;
17. begin
18.   if ssleft in shift then
19.     begin
20.       redboxX:= shape1.Left;
21.       redboxY:= shape1.Top;
22.       Shape1.Left:= round(redboxX+X);
23.       Shape1.Top:= round(redboxY+Y);
24.       Scrollbox1.HorzScrollBar.ScrollPos := round((Shape1.Left * Image2.Picture.Width) / image1.Width);  <-- This produces a compilation error
25.       Scrollbox1.VertScrollBar.ScrollPos := round(Shape1.Top / (image1.Height/Image2.Picture.Height)); <-- This produces a compilation error
26.     end
27. end;                          

I tried to reverse the piece of code you proposed to calculate the shape size and position. I took the position algorith and reversed, but it results on compilation error:

unit1.pas(157,17) Error: Argument cannot be assigned to
unit1.pas(158,17) Error: Argument cannot be assigned to

Those lines are these:

Code: Pascal  [Select][+][-]

1. Scrollbox1.HorzScrollBar.ScrollPos := round((Shape1.Left * Image2.Picture.Width) / image1.Width);  <-- This produces a compilation error
2.       Scrollbox1.VertScrollBar.ScrollPos := round(Shape1.Top / (image1.Height/Image2.Picture.Height));

I attach the new version of the demo project

[howardpc]

Try this:

Code: Pascal  [Select][+][-]

1. procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
2. var
3.   deltaX, deltaY: Integer;
4. begin
5.   if ssleft in shift then
6.     begin
7.       deltaX := Round((Shape1.Left * Image2.Picture.Width) / image1.Width);
8.       deltaY := Round(Shape1.Top / (Image1.Height/Image2.Picture.Height));
9.       Shape1.Left := Shape1.Left + X;
10.       Shape1.Top := Shape1.Top + Y;
11.       ScrollBox1.ScrollBy(deltaX, deltaY);
12.     end
13. end;

[barsoom]

Thanks @howardpc.
Now it compiles, but it does not change the position of the main image... in fact, after releasing the mouse left button, the redbox returns to the original position! Meanwhile the mainimage does not change at all its position.

[loaded]

If you want the process to work bidirectionally, we will need to make minor changes.

First, let's add the following variables:

Code: Pascal  [Select][+][-]

1. var
2.   Form1: TForm1;
3.   FShapeDragging : boolean;
4.   FShapeDownLocation,FShapeStartingLocation : TPoint;  

Let's set the mouse events of the shape as follows.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
2.   Shift: TShiftState; X, Y: Integer);
3. begin
4.   FShapeDragging := true;
5.   FShapeDownLocation := Mouse.CursorPos;
6.   FShapeStartingLocation := TPoint.Create(TShape(sender).left, TShape(sender).top);
7. end;
8.  
9.  
10.  
11. procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
12.   Y: Integer);
13. begin
14.   if FShapeDragging then begin
15.   TShape(sender).left := FShapeStartingLocation.X + (Mouse.CursorPos.X - FShapeDownLocation.X);
16.   TShape(sender).top := FShapeStartingLocation.Y + (Mouse.CursorPos.Y - FShapeDownLocation.Y);
17.   Scrollbox1.HorzScrollBar.Position:=round(Shape1.Left/(image1.Width/Image2.Picture.Width));
18.   Scrollbox1.VertScrollBar.Position:=round(Shape1.Top/(image1.Height/Image2.Picture.Height))
19.   end;
20. end;
21.  
22. procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
23.   Shift: TShiftState; X, Y: Integer);
24. begin
25.   FShapeDragging := false;
26. end;

And let's put the final touch here.

Code: Pascal  [Select][+][-]

1. procedure TForm1.RedBoxExecute(Sender: TObject);
2. begin
3.   if not FShapeDragging then begin //added
4.   Shape1.Width:=round(ScrollBox1.ClientWidth*(image1.Width/Image2.Picture.Width));
5.   Shape1.Height:=round(ScrollBox1.ClientHeight*(image1.Height/Image2.Picture.Height));
6.   Shape1.Left:=round(Scrollbox1.HorzScrollBar.ScrollPos*(image1.Width/Image2.Picture.Width));
7.   Shape1.Top:=round(Scrollbox1.VertScrollBar.ScrollPos*(image1.Height/Image2.Picture.Height));
8.   end;
9. end;

[barsoom]

Great solution @Loaded!!

It works nicely. Nice idea the final touch. I didn´t think on that option.

The unique issues i could see are:
1)  that the scrollbox moves really quick as you move the redbox, but the image itselft replies with a delay. May be because i am testing with  relatively big image about 2600x1800 pixels. However, it also occurs with the main image panning.
2) the redbox shows also a delay respect the movement of the pointer.

I attach the new version with a modification on the onMouseUp event to avoid leave the redbox outside the thumbnail, using this code:

Code: Pascal  [Select][+][-]

1. procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
2.   Shift: TShiftState; X, Y: Integer);
3. begin
4.   FShapeDragging := false;
5.   //few new lines of code to avoid leave the redbox outside the thumbnail
6.   if shape1.top < 0 then shape1.top := 0
7.     else if shape1.top > (image1.Height - shape1.Height) then shape1.Top := (image1.Height - shape1.Height);
8.   if shape1.left < 0 then shape1.left := 0
9.     else if shape1.left > (image1.Width - shape1.Width) then shape1.Left := (image1.Width - shape1.Width)
10. end;

[loaded]

Yes, it is inevitable to have stutters in large image files.
But the last point I will put forward with the material at hand and my apprenticeship knowledge; It will improve the situation just a little bit.
Of course there are better ones, but I don't know that either.

Primarily for large memory requirements;

Code: Pascal  [Select][+][-]

1. {$R *.lfm}
2. {$SetPEFlags $0020}      

We save memory by shrinking the image preview process;

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. var
3.   buffer:TPicture;  //added for resize image
4. begin
5.   if openpicturedialog1.Execute then
6.      begin
7.        Screen.cursor:=crHourGlass;
8.        image1.Proportional:=false;
9.        buffer:=TPicture.Create; //added
10.        buffer.LoadFromFile(openpicturedialog1.FileName); //added
11.        image1.Canvas.StretchDraw(Rect(0, 0, image1.Width, Image1.Height), buffer.Bitmap); //added
12.        Image2.Enabled:=True;
13.        Image2.AntialiasingMode:=amOff; //added
14.        image2.Picture.Assign(buffer); //added
15.        buffer.free; //added
16.        RedBox.Execute;
17.        Shape1.visible:=True;
18.      end;
19.   Screen.cursor := crDefault;
20. end;  

[barsoom]

wow @loaded, Really much much better! Thanks so much!!

I added your inputs and it work nicely well.

I also added a magnifier option. I used it in a short program i did long long time ago with delphi, but still works in Lazarus. I am sure it could be improved, but here it is.

May be it coud be usefull to others.