How to Strech an image correctly

[Weitentaaal]

Hello,

i have problems loading a png File into an image.
I use this Code:

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

1. procedure TVGraph.LoadPNG(Path: string);
2. var
3.    BitMap: TBitmap;
4. begin
5.    fPath:= Path;
6.    if FileExists(Path) then begin
7.       BitMap:= TBitmap.Create;
8.       VKurve.Picture.LoadFromFile(Path);
9.  
10.       Bitmap.SetSize(VKurve.Width, VKurve.Height);
11.       Bitmap.Canvas.StretchDraw(Rect(0,0,VKurve.Width, VKurve.Height), VKurve.Picture.Bitmap);
12.  
13.       VKurve.Picture.Bitmap.Assign(BitMap);
14.       BitMap.Free;
15.    end else begin
16.       CustomMessage('', 'No File found !', cmError); //Failed to load File, File not found
17.    end;
18. end;
19.  

the Picture will load into the image and is streched correctly but it looks awful, see attached Example.
how do i have to change the Code for the image to look good ?

thanks in advance.

[KodeZwerg]

You can do...

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

1. uses ...BGRABitmap, BGRABitmapTypes...
2.  
3. function Resample(const ASource: TBGRABitmap; const AWidth, AHeight: Integer): TBGRABitmap;
4. begin
5.   ASource.ResampleFilter := rfLanczos2;
6.   Result := ASource.Resample(AWidth, AHeight);
7. end;
8.  
9. procedure TForm1.Button1Click(Sender: TObject);
10. var
11.   bmp1, bmp2: TBGRABitmap;
12. begin
13.   if FileExists('.\HowItShouldLook.png') then
14.     begin
15.       bmp1 := TBGRABitmap.Create;
16.       bmp2 := TBGRABitmap.Create;
17.       try
18.         bmp1.LoadFromFile('.\HowItShouldLook.png');
19.         bmp2 := Resample(bmp1, Image1.Width, Image1.Height);
20.         Image1.Proportional := True;
21.         Image1.Stretch := True;
22.         Image1.Picture.Assign(bmp2);
23.       finally
24.         bmp2.Free;
25.         bmp1.Free;
26.       end;
27.     end;
28. end;

At least the final content does look better that way.

[Weitentaaal]

that looks a lot better thank you  !!

[wp]

The TCanvas.StretchDraw has a very crispy output which not necessarily corresponds with high quality. You get much better quality if you apply the StretchDraw method of the TFPCustomCanvas; (like in BGRABitmap) you can select among several interpolation algorithms. There is a wiki article about what to do: https://wiki.freepascal.org/Developing_with_Graphics#Using_the_non-native_StretchDraw_from_LazCanvas, and since Laz 2.2+ this procedure has been included in a modified version in unit GraphUtil.

I copied the "AntiAliasedStretchDraw" into the attached project in which you can scale the input image to any size and compare with the output of TCanvas.StretchDraw.

[Weitentaaal]

Both solutions do work very well for me, can't realy see any Difference in quality.

thank you both !

[cdbc]

Hi
@KodeZwerg: I think your code is leaking a bitmap:

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

1. uses ...BGRABitmap, BGRABitmapTypes...
2.  
3. function Resample(const ASource: TBGRABitmap; const AWidth, AHeight: Integer): TBGRABitmap;
4. begin
5.   ASource.ResampleFilter := rfLanczos2;
6.   //1) the line below creates a new bitmap from resampling in Result...
7.   Result := ASource.Resample(AWidth, AHeight);
8. end;
9.  
10. procedure TForm1.Button1Click(Sender: TObject);
11. var
12.   bmp1, bmp2: TBGRABitmap;
13. begin
14.   if FileExists('.\HowItShouldLook.png') then
15.     begin
16.       bmp1 := TBGRABitmap.Create;
17.       //2) bmp2 should not be created here, it will be overwritten...
18. // leak      bmp2 := TBGRABitmap.Create;
19.       try
20.         bmp1.LoadFromFile('.\HowItShouldLook.png');
21.         //3) in the next line by the result from function
22.         bmp2 := Resample(bmp1, Image1.Width, Image1.Height);
23.         Image1.Proportional := True;
24.         Image1.Stretch := True;
25.         Image1.Picture.Assign(bmp2);
26.       finally
27.         bmp2.Free;
28.         bmp1.Free;
29.       end;
30.     end;
31. end;
32.  

Just skip the line "leak", namely: bmp2 := TBGRABitmap.Create;
Regards Benny

[KodeZwerg]

@KodeZwerg: I think your code is leaking a bitmap:

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

1. [/quote]
2. Ahhh by watching BGRA source you are right, I hate such when methods not named "Create" are "creating" things.
3. (CreateResample would be a better choice of name)

[jamie]

https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-setstretchbltmode

[KodeZwerg]

https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-setstretchbltmode

Here's an example that includes 3 methods, BGRA, wp's and jamie's suggestion as pascal code.
My eyes are not the best, to me all looking "okay" and somehow "same" 

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows,
9.   BGRABitmap, BGRABitmapTypes,
10.   fpCanvas, IntfGraphics, LazCanvas,
11.   Classes , SysUtils , Forms , Controls , Graphics , Dialogs , ExtCtrls ,
12.   StdCtrls;
13.  
14. type
15.  
16.   { TForm1 }
17.  
18.   TForm1 = class(TForm)
19.     Button1: TButton;
20.     Image1: TImage;
21.     Image2: TImage;
22.     Image3: TImage;
23.     procedure Button1Click(Sender: TObject);
24.     procedure FormResize(Sender: TObject);
25.   private
26.  
27.   public
28.  
29.   end;
30.  
31. var
32.   Form1: TForm1;
33.  
34. implementation
35.  
36. {$R *.lfm}
37.  
38. procedure CreateRescaleBitmap(const Source: TBitmap; const Width, Height: Integer; out Rescaled: TBitmap);
39. var
40.   DC: HDC;
41.   MemDC: HDC;
42.   Bitmap: HBITMAP;
43.   OldBitmap: HBITMAP;
44. begin
45.   DC := GetDC(0);
46.   try
47.     MemDC := CreateCompatibleDC(DC);
48.     try
49.       Bitmap := CreateCompatibleBitmap(DC, Width, Height);
50.       OldBitmap := SelectObject(MemDC, Bitmap);
51.  
52.       SetStretchBltMode(MemDC, HALFTONE);
53.       SetBrushOrgEx(MemDC, 0, 0, nil);
54.  
55.       StretchBlt(MemDC, 0, 0, Width, Height, Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, SRCCOPY);
56.  
57.       Rescaled := TBitmap.Create;
58.       Rescaled.Assign(Source);
59.       Rescaled.Width := Width;
60.       Rescaled.Height := Height;
61.       BitBlt(Rescaled.Canvas.Handle, 0, 0, Width, Height, MemDC, 0, 0, SRCCOPY);
62.  
63.       SelectObject(MemDC, OldBitmap);
64.       DeleteObject(Bitmap);
65.     finally
66.       DeleteDC(MemDC);
67.     end;
68.   finally
69.     ReleaseDC(0, DC);
70.   end;
71. end;
72.  
73. procedure AntiAliasedStretchDrawBitmap(SourceBitmap, DestBitmap: TCustomBitmap);
74. var
75.   DestIntfImage, SourceIntfImage: TLazIntfImage;
76.   DestWidth, DestHeight: Integer;
77.   DestCanvas: TLazCanvas;
78. begin
79.   DestWidth := DestBitmap.Width;
80.   DestHeight := DestBitmap.Height;
81.   DestIntfImage := TLazIntfImage.Create(0, 0);
82.   try
83.     DestIntfImage.LoadFromBitmap(DestBitmap.Handle, DestBitmap.MaskHandle);
84.     DestCanvas := TLazCanvas.Create(DestIntfImage);
85.     try
86.       SourceIntfImage := SourceBitmap.CreateIntfImage;
87.       try
88.         DestCanvas.Interpolation := TFPBaseInterpolation.Create;
89.         try
90.           DestCanvas.StretchDraw(0, 0, DestWidth, DestHeight, SourceIntfImage);
91.           DestBitmap.LoadFromIntfImage(DestIntfImage);
92.         finally
93.           DestCanvas.Interpolation.Free;
94.         end;
95.       finally
96.         SourceIntfImage.Free;
97.       end;
98.     finally
99.       DestCanvas.Free;
100.     end;
101.   finally
102.     DestIntfImage.Free;
103.   end;
104. end;
105.  
106.  
107. function Resample(const ASource: TBGRABitmap; const AWidth, AHeight: Integer): TBGRABitmap;
108. begin
109.   ASource.ResampleFilter := rfBestQuality;
110.   Result := ASource.Resample(AWidth, AHeight);
111. end;
112.  
113. { TForm1 }
114.  
115. procedure TForm1.Button1Click(Sender: TObject);
116. var
117.   bgr1, bgr2: TBGRABitmap;
118.   png1, png2: TPortableNetworkGraphic;
119.   bmp1, bmp2: TBitmap;
120. begin
121.   if FileExists('.\HowItShouldLook.png') then
122.     begin
123.       // Image1 @ GDI+
124.       png1 := TPortableNetworkGraphic.Create;
125.       bmp1 := TBitmap.Create;
126.       try
127.         png1.LoadFromFile('.\HowItShouldLook.png');
128.         bmp1.Assign(png1);
129.         CreateRescaleBitmap(bmp1, Image1.Width, Image1.Height, bmp2);
130.         Image1.Proportional := True;
131.         Image1.Stretch := True;
132.         Image1.Picture.Assign(bmp2);
133.       finally
134.         bmp2.Free;
135.         bmp1.Free;
136.         png1.Free;
137.       end;
138.  
139.       // Image2 @ BGRA
140.       bgr1 := TBGRABitmap.Create;
141.       bgr2 := TBGRABitmap.Create;
142.       try
143.         bgr1.LoadFromFile('.\HowItShouldLook.png');
144.         bgr2 := Resample(bgr1, Image2.Width, Image2.Height);
145.         Image2.Proportional := True;
146.         Image2.Stretch := True;
147.         Image2.Picture.Assign(bgr2);
148.       finally
149.         bgr2.Free;
150.         bgr1.Free;
151.       end;
152.  
153.       // Image3 @ Canvas
154.       png1 := TPortableNetworkGraphic.Create;
155.       bmp1 := TBitmap.Create;
156.       bmp2 := TBitmap.Create;
157.       try
158.         png1.LoadFromFile('.\HowItShouldLook.png');
159.         bmp1.Assign(png1);
160.         bmp2.SetSize(Image3.Width, Image3.Height);
161.         AntiAliasedStretchDrawBitmap(bmp1, bmp2);
162.         Image3.Proportional := True;
163.         Image3.Stretch := True;
164.         Image3.Picture.Assign(bmp2);
165.       finally
166.         bmp2.Free;
167.         bmp1.Free;
168.         png1.Free;
169.       end;
170.  
171. (*
172.       // classical not pretty windows method
173.       png1 := TPortableNetworkGraphic.Create;
174.       png2 := TPortableNetworkGraphic.Create;
175.       try
176.         png1.LoadFromFile('.\HowItShouldLook.png');
177.         png2.SetSize(Image1.Width, Image1.Height);
178.         StretchBlt(png2.Canvas.Handle, //destination HDC
179.           0, 0, Image1.Width, Image1.Height, // destination size
180.           png1.Canvas.Handle, //source HDC
181.           0, 0, png1.Width, png1.Height, // source size
182.           SrcCopy);
183.         Image1.Picture.Assign(png2);
184.       finally
185.         png2.Free;
186.         png1.Free;
187.       end;
188. *)
189.     end;
190. end;
191.  
192. procedure TForm1.FormResize(Sender: TObject);
193. begin
194.   Image1.Width := Form1.ClientWidth div 3;
195.   Image2.Width := Form1.ClientWidth div 3;
196. end;
197.  
198. end.