[SOLVED] Problem to show a margin around a TImage on a TScrollBox

[Hartmut]

I'm a beginner with Graphics. I want to write a Class which shows a picture file (e.g. *.png or *.jpg) with a selectable scaling factor on a TImage. Because the (scaled) Picture can be greater than 1 monitor (which is my maximal Form size), the TImage resides on a TScrollBox. Around the picture there shall be a yellow Margin of 10 pixels. If there are scrollbars, then the yellow Margin shall not be visible, until you have scrolled to that margin. This way a missing yellow margin indicates from far, that you must scroll to see the complete picture.

This is a small demo code to show my problem:

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

1. {Demo for the Forum to show the problem with the yellow margin arround the
2.  picture}
3.  
4. unit Unit1;
5.  
6. {$mode objfpc}{$H+}
7.  
8. interface
9.  
10. uses
11.  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, math;
12.  
13. const FileSpec = 'demo.png'; {picture file to show}
14.       Margin = 10; {Margin for background-color in 'clYellow'}
15.  
16. type
17.  { TForm1 }
18.  TForm1 = class(TForm)
19.   Image1: TImage;
20.   Picture1: TPicture;
21.   ScrollBox1: TScrollBox;
22.  
23.   procedure showPicture(fspec: string);
24.   procedure FormActivate(Sender: TObject);
25.  private
26.  public
27.  end;
28.  
29. var
30.  Form1: TForm1;
31.  
32. implementation
33.  
34. {$R *.lfm}
35.  
36. { TForm1 }
37.  
38. procedure TForm1.showPicture(fspec: string);
39.    {shows the picture in file 'fspec' with a certain scaling factor 'f'}
40.    const MaxFormWidth = 1000; {wanted max. Form.Width}
41.          MaxFormHeight = 800; {wanted max. Form.Height}
42.    var f: double;
43.        pax,pay, w,h: integer;
44.    begin
45.    Picture1:=TPicture.Create;
46.  
47.    try
48.       Picture1.LoadFromFile(fspec);
49.    except
50.       on E:Exception do
51.          begin
52.          ShowMessage('Error on loading file!');
53.          Picture1.Free;
54.          exit;
55.          end;
56.    end; {try}
57.  
58.    pax:=Picture1.Width; pay:=Picture1.Height; {store original picture size}
59.    writeln('Original = ', pax, ' x ', pay);
60.    Image1.Picture.Bitmap.SetSize(pax,pay);    {set Image size}
61.  
62.    f:=1.0;          {select or compute the scaling factor: }
63. // f:=0.78;         {for values <= 0.78 no scrollbars are neccessary}
64.  
65.    w:=round(pax*f); {new picture width}
66.    h:=round(pay*f); {new picture height}
67.  
68.    Image1.Stretch:=true;
69.    Image1.Left:=Margin;
70.    Image1.Top:=Margin;
71.    Image1.Width:=w;
72.    Image1.Height:=h;
73.  
74.    Image1.Picture.Bitmap.Canvas.Draw(0,0, Picture1.Bitmap); {show picture}
75.    writeln('Image1 = ', Image1.Width, ' x ', Image1.Height);
76.  
77.    inc(w,2*Margin); {set Form size: }
78.    inc(h,2*Margin);
79.    self.SetBounds(0,0,min(MaxFormWidth,w),min(MaxFormHeight,h));
80.  
81.    Picture1.Free;
82.    end; {showPicture}
83.  
84. procedure TForm1.FormActivate(Sender: TObject);
85.    const first: boolean = true;
86.    begin
87.    if not first then exit;
88.  
89.    first:=false;
90.    ScrollBox1.Align:=alClient;
91.    ScrollBox1.BorderStyle:=bsNone;
92.    ScrollBox1.HorzScrollBar.Tracking:=true; {scroll in Realtime: }
93.    ScrollBox1.VertScrollBar.Tracking:=true;
94.    ScrollBox1.Color:=clYellow;
95.  
96. (*    // enables a correct yellow Margin, but disables the ScrollBars:
97.    Image1.Align:=alClient;
98.    Image1.BorderSpacing.Left:=Margin;
99.    Image1.BorderSpacing.Top:=Margin;
100.    Image1.BorderSpacing.Right:=Margin;
101.    Image1.BorderSpacing.Bottom:=Margin;
102. *)
103.    showPicture(FileSpec); {shows the picture in file 'FileSpec'}
104.    end;
105.  
106. end.

Attached is my demo as a compilable project including a picture file "demo.png" of 1200 x 1000 pixel. If you show this file with my demo and a scaling factor of f=1.0 then the yellow left and top margins work as they should: they are visible, if you have completely scrolled to the left respectively to the top (see screenshot1). But the yellow right and bottom margins are never visible, even if you have completely scrolled to the right respectively to the bottom (see screenshot2). That is wrong and I need help to correct this.

Normally (in my real program) const 'MaxFormWidth' and 'MaxFormHeight' are values, which are taken from self.Monitor.WorkareaRect.Width and .Height, but to have reproducible results independently from your Monitor size, I used constants, which are smaller than the picture file, so that both scrollbars (for a scaling factor of f=1.0) are visible.

If you use a scaling factor of <= 0.78 (see line 63) than no scrollbars are neccessary and all 4 yellow margins are visible (see screenshot3), which is correct.

Please can somebody help? I use Lazarus 2.0.10 / FPC 3.2.0 but have the same results with Lazarus 3.4 / FPC 3.2.2 (on Windows 7 and Linux Ubuntu 22.04). Thanks in advance.

[Hartmut]

Hmmm, not even 1 answer after 3 days... Was my question noch understandable enough?

I want to display a picture file (with a selectable scaling factor) on a TImage. Around the picture there shall be a yellow Margin of 10 pixels. If the picture is greater (has more pixels) than the TImage, then there shall be ScrollBars. That's why I placed the TImage on a TScrollBox. To realize the yellow Margin, I used the background color of the TScrollBox (see line 94). That means, the TScrollBox must be 10 pixels greater than the TImage on each 4 sides.

If the scaling factor is <= 0.78 (see line 63), than no scrollbars are neccessary and all 4 yellow margins are visible (see screenshot3), which is perfect.

If the scaling factor is e.g. 1.0 (see line 62), than scrollbars are neccessary. In this case the yellow left and top margins work as they should: they are visible, if you have completely scrolled to the left respectively to the top (see screenshot1). But the yellow right and bottom margins are never visible, even if you have completely scrolled to the right respectively to the bottom (see screenshot2). That is wrong and I need help to correct this. If you start the attached demo (with the included file demo.png) you'll see what I mean.

Please help. If you have questions, please ask.

[Dzandaa]

Hi,

I don't know if this is what you want, but try it.

B->

[VisualLab]

Thinking of it quickly, I would do it like this:

• I would place a TScrollBox on the form and a TPaintBox inside it,
• an image intended for scaled display would be loaded into a bitmap (TBitmap),
• then the bitmap size (WB, HB) after scaling would be calculated, the original bitmap size and scaling factor (Scale) set by the user would be used for calculations,
• the calculated sizes (WB, HB) of the bitmap would be increased by the width of the yellow margin (M), thus determining the final size of the bitmap with margins (WBM, HBM),
• the bitmap content will be drawn on the TPaintBox canvas, where the top left corner of the bitmap would be placed on the TPaintBox at the point set by the margin width (M, M), i.e. the left and top edges of the bitmap drawn on the TPaintBox would be offset by the width of the yellow margin,
• now a yellow rectangle would be drawn without fill (because there is supposed to be a bitmap inside), so that the upper left corner of the rectangle would have coordinates (0, 0).

Finally, I would add code to calculate the position of the TPaintBox inside the TScrollBox so that:

• when the TPaintBox is larger than the TScrollBox, the top left corner of the TPaintBox would be placed in the top left corner of the TScrollBox,
• when the TPaintBox is smaller than the TScrollBox, the TPaintBox would be centered vertically and horizontally inside the TScrollBox.

[Hartmut]

Thanks a lot Dzandaa for trying to help me. But your yellow margin is *always* visible to all 4 sides, even if you have not completely scrolled to that side. I need the yellow margin to be part of that, what is moved, when you scroll. If you start my demo with scaling factor = 1.0 then you can see this happen for the left margin and top margin (but it does not work for the right margin and bottom margin). And I need the possibility of a scaling factor (which might be computed or selected from a list).

Thank you very much VisualLab for that detailed list. However I see a couple of difficulties to realize that for me as a beginner to Graphics. I will try and report if I have specific questions.

[wp]

Try this one. Like VisualLab I prefer to use a TPaintbox for this purpose, it gives me more control (and understanding) of what's happening.

[Hartmut]

Thank you very much wp for your demo. It does exactly what I wanted:
 - the yellow margin is part of the area, which is moved, when you scroll
 - there exists a scaling factor (which can be computed or selected from a list).

What I not yet understand:
a) What makes Event 'PaintBox1Paint' fire? A special command in 'ShowPicture'? Or something like 'Application.ProcessMessages'? What/where is the trigger for that Event?

b) I expanded Event 'PaintBox1Paint' with 1 'writeln' at it's beginning and saw, that this Event is always fired *twice*, if I scroll by "1 page" (click once in the area beside the scrollbar). Same when I scroll by "1 line" (click on the little arrow at the end of the scrollbar). Why is this Event always fired twice instead of once? Is this neccessary?

It would help me to understand and to learn if you could explain this.

[wp]

Paintbox.OnPaint (like the OnPaint of other some controls) fires always when the operating system decides that the control must be repainted., for example when another window is dragged over the control, or the form is minimized and then restored. The usual way to trigger the redraw cycle manually is to call the control's Invalidate method ("invalidate" means here that the graphical display of the control is marked to be no longer valid, and the control will be redrawn when the OS performs a paint operation).

IIRC (I don't have my code here ATM), I did not put an explicit Paintbox.Invalidate in ShowPicture because this method is executed early in the OnCreate event, and therefore will be redraw anyway. And IIRC, there is also a SetBounds which changes the size of the form and this triggers a redraw as well. But anyway, adding a Paintbox.Invalidate is not harmful because it is not executed immediately but put into the OS message queue, where multiple same commands are combined to one.

I don't know why your Paintbox is painted twice, maybe it's caused by the WriteLn when the application writes to the console. For a test, you could simply add a memo to the form, and in the OnPaint event you send some text to the memo (Memo1.Lines.Add(some_text)).

[Hartmut]

Thanks a lot wp for your explanations. Now I understand more.

I don't know why your Paintbox is painted twice, maybe it's caused by the WriteLn when the application writes to the console. For a test, you could simply add a memo to the form, and in the OnPaint event you send some text to the memo (Memo1.Lines.Add(some_text)).

I did as you suggested and replaced 'writeln' by 'Memo1.Lines.Add'. This too is always called *twice* when you scroll in the way which I described in reply #6. But I found out that this is only twice on Linux (Ubuntu 22.04 64-bit) and not on Windows (Win7 32-bit). Strange... I assume that this will not speed up things, especially if the picture and/or scaling factor is big.

[wp]

Seems to be an issue with gtk. Tested my demo app and "WriteLn" in Manjaro Linux. When I compile for gtk2 and gtk3 I get the double events, but when I compile for qt5 or qt6 there are only single events.

[Hartmut]

I can compile on Linux for gtk2 and qt5 and can confirm, that with qt5 scrolling fires Event 'PaintBox1Paint' only once. But with qt5, if you have a TMemo, Event 'PaintBox1Paint' is fired permanentely once a second - even if you do nothing - I assume only for the blinking cursor in TMemo.

Enough reasons to optimize Event 'PaintBox1Paint' for speed (especially if the picture and/or scaling factor is big):

First from my understanding I thought, that I could move these 2 lines

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

1. Paintbox1.Canvas.Brush.Color := clYellow;
2. Paintbox1.Canvas.FillRect(0, 0, Paintbox1.Width, Paintbox1.Height);

from 'PaintBox1Paint' to 'ShowPicture' (because they "only" draw the yellow margin/background), but this did not work. Then I replayed these 2 lines with

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

1. ScrollBox1.Color:=clYellow;

into 'FormActivate' which seems to work. Do you have any doubts to do so?

Second from my understanding I think that these 4 lines

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

1. w := round(FScalingFactor * FPicture.Width);
2. h := round(FScalingFactor * FPicture.Height);
3. R := Rect(Margin, Margin, w + Margin, h + Margin);
4. Paintbox1.Canvas.StretchDraw(R, FPicture.Bitmap);

in 'PaintBox1Paint' are time consuming, because the complete transformation and stretching is repeated for every scrolling step. I wanted to excecute this steps only once and moved these 4 lines from 'PaintBox1Paint' to 'ShowPicture' and disabled Event 'PaintBox1Paint' completely (because now it was empty). But this did not work (the picture was not shown, even these 2 additional commands

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

1. Paintbox1.Invalidate;
2. Application.ProcessMessages;

did not help).

Do you have an idea why this does not work? And do you have an idea, how the complete transformation and stretching could be removed from 'PaintBox1Paint' into 'ShowPicture', so that Event 'PaintBox1Paint' needs only to draw a ready-to-use picture, which is already stored there in? Thanks a lot.

[wp]

Moving drawing code from the Paintbox.OnPaint to some independent procedures is not a good idea because the code in OnPaint tells the paintbos how it should redraw itself. When you worry about speed loss due to stretching the image with every redraw you could create a buffer bitmap, in which you draw the yellow border and stretch-draw the original image - this can be done in ShowPicture. But then in paintbox.OnDraw you simply draw that buffer bitmap to the canvas of the paintbox.

This is similar to a TImage which does have this internal buffer bitmap for drawing, but what's confusing for me always is to distinguish from the original loaded image.

See attached modified test project

[Hartmut]

Great! That's exactly what I searched for. Now scrolling even with a scaling factor of 12 is smooth and fast, while with the old demo it was very slow and bumpy. Thank you very much, wp!

But with a scaling factor of 15 I get a bad crash: my Linux session aborts and I must login anew.

a) When I start the program from within the IDE, then the exception in 'ShowPicture' is caught and I get the message 'Error on loading file' and no crash.
b) But when I start the program from within a console (what I normally do), then I get the described crash. I put some 'writeln' in procedure 'ShowPicture':

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

1. procedure TForm1.ShowPicture(FSpec: String);
2. var
3.   w, h: Integer;
4.   R: TRect;
5. begin
6.   FPicture.Free;    // To prevent memory leak when ShowPicture might be called a second time
7.   FPicture := TPicture.Create;
8.   if FBuffer = nil then FBuffer := TBitmap.Create;
9.  
10. writeln('FScalingFactor=', FScalingFactor:0:2);
11.  
12.   try
13. writeln('AAA');
14.     FPicture.LoadFromFile(FSpec);
15. writeln('BBB');
16.  
17.     w := round(FScalingFactor*FPicture.Width) + 2*Margin;
18.     h := round(FScalingFactor*FPicture.Height) + 2*Margin;
19.     Paintbox1.SetBounds(0, 0, w, h);
20. writeln('CCC');
21.  
22.     SetBounds(0, 0, Min(Paintbox1.Width, MaxFormWidth), Min(Paintbox1.Height, MaxFormHeight));
23. writeln('DDD');
24.  
25.     FBuffer.SetSize(w, h);
26. writeln('EEE');
27.     FBuffer.Canvas.Brush.Color := clYellow;
28. writeln('FBuffer: ', FBuffer.Width, ' x ', FBuffer.Height);
29.     FBuffer.Canvas.FillRect(0, 0, FBuffer.Width, FBuffer.Height);
30. writeln('FFF');
31.     R := Rect(Margin, Margin, FBuffer.Width - Margin, FBuffer.Height - Margin);
32. writeln('GGG');
33.     FBuffer.Canvas.StretchDraw(R, FPicture.Bitmap);
34. writeln('HHH');
35.  
36.   except
37.     on E:Exception do
38.       begin
39.         ShowMessage('Error on loading file!');
40.         FreeAndNil(FPicture);
41.         FreeAndNil(FBuffer);
42.         exit;
43.       end;
44.   end;
45. end;

and the last message which I see before the crash is 'GGG'. I'm surprised that from within the IDE the exception in 'ShowPicture' is caught, while from within a console, I get the described crash. I could live with, that a greater scaling factor than 14 (for a picture of that size) is not possible, but there should not be this crash, that you must login to Linux anew.

Testet with Lazarus 3.99 (rev main_3_99-2316-g00f3d3b397) FPC 3.3.1 x86_64-linux-gtk2 on Linux Ubuntu 22.04 64-bit with 8 GB RAM. Do you think that this is a bug, which should/could be fixed?

[wp]

On my 4GB notebook the demo probably runs out of memory. The 1200x1000  bitmap magnified for the buffer by a factor 15 on both sides takes 1GB  of memory. On my system two empty forms appear, and after long waiting the magnified image comes up. But the application is dead. I only can open a console and kill the process. Maybe there is not even the memory to display the ShowMessage any more (the second empty form?)

But I have no idea what is happening on your machine with 8 GB...

If you really need such high magnification factors, you should use a tiled image (i.e. stretch-draw parts of the image into a smaller rectangle which you draw on the paintbox until it is completely filled.

[Hartmut]

Thank you wp for that informations. I can live with this restriction. And this is (hopefully) my last question:

In 'ShowPicture' and 'PaintBox1Paint' you write:

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

1. if FBuffer = nil then ...

but 'FBuffer' is nowhere set to 'nil'. Can I rely on that *all* variables/properties of a class are set to zero when the class is created?