Problem with StretchDraw()
lazarus / 39-Graphics

----------------------------------------------------------------------
shyub · 2023-10-05 03:47

You need to open the file with the picture:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
Bmp.LoadFromFile(OpenPictureDialog1.FileName);Then scale:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i MyBmp:=TBit
map.Create;MyBmp.Width:=100;MyBmp.Height:=100;MyBmp.Canvas.StretchDraw
(Rect(0, 0, MyBmp.Width, MyBmp.Height), Bmp);However, after MyBMP is
displayed on the screen, only a white background is obtained. (Output
from Bmp - works without scaling.)

----------------------------------------------------------------------
paweld · 2023-10-05 05:09

What system, version of lazarus and fpc? It would be best to include
an example showing the problem.
There is no such problem on the current version.
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Button1Click(Sender: TObject);var  bmp, bmpscale:
TBitmap;begin  if not OpenDialog1.Execute then    exit;  Invalidate; 
bmp := TBitmap.Create;  bmp.LoadFromFile(OpenDialog1.FileName); 
bmpscale := TBitmap.Create;  bmpscale.Width := 100;  bmpscale.Height
:= 100;  bmpscale.Canvas.StretchDraw(Rect(0, 0, bmpscale.Width,
bmpscale.Height), bmp);  Canvas.Draw(10, 50, bmpscale); 
Canvas.Draw(10 + bmpscale.Width + 20, 50, bmp);  bmp.Free; 
bmpscale.Free;end;

----------------------------------------------------------------------
shyub · 2023-10-05 11:22

Windows-10 x64, Lazarus 2.0.12.
Problem still exists.

----------------------------------------------------------------------
Josh · 2023-10-05 12:17

Hi

Tbitmap has very limited support of image filetypes.
TPicture has much better support.

Also note your drawing straight to form canvas, this is not persitant,
any form repainting and the imagewill vanish.

IIRC When a bitmap is created with width, height its filled with $FF
ie white, delphi fills with $00


Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var
myPic:TPicture;    myBMP:Tbitmap;begin  try    myPic :=
TPicture.Create;    myPic.LoadFromFile(OpenDialog1.FileName);    try 
   myBMP := TBitmap.Create;      myBMP.Width := 100;      myBMP.Height
:=100;      myBMP.Canvas.StretchDraw(Rect(0, 0, myBMP.Width,
myBMP.Height), myPic.Graphic);      Canvas.Draw(10, 50, myBMP);     
Canvas.Draw(10 + myBMP.Width + 20, 50, myPic.Graphic);    finally    
myBMP.Free;    end;  finally    myPic.Free;  end;end;

----------------------------------------------------------------------
paweld · 2023-10-05 12:45

I checked on version 2.0.12 and it is also ok.
But maybe you have a problem somewhere else - as @Josh writes such way
of drawing on the form is non-permanent, i.e. every time you refresh
the form the canvas will be cleared.
If you want to have "permanent" drawing on the form then use the
OnPaint event.

i.e:Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var  bmp,
bmpscale: TBitmap; procedure TForm1.Button1Click(Sender:
TObject);begin  if not OpenDialog1.Execute then    exit;     
bmp.LoadFromFile(OpenDialog1.FileName); 
bmpscale.Canvas.StretchDraw(Rect(0, 0, bmpscale.Width,
bmpscale.Height), bmp);  Invalidate;end; procedure
TForm1.FormCreate(Sender: TObject);begin  bmp := TBitmap.Create; 
bmpscale := TBitmap.Create;  bmpscale.Width := 100;  bmpscale.Height
:= 100;end; procedure TForm1.FormDestroy(Sender: TObject);begin 
bmp.Free;  bmpscale.Free;end; procedure TForm1.FormPaint(Sender:
TObject);begin  if bmp.Width > 0 then  begin;    Canvas.Draw(10, 50,
bmpscale);    Canvas.Draw(10 + bmpscale.Width + 20, 50, bmp); 
end;end;

----------------------------------------------------------------------
KodeZwerg · 2023-10-05 15:12

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Button1Click(Sender: TObject);var  bmp: TBitmap;begin  if
OpenPictureDialog1.Execute then    begin      bmp := TBitmap.Create; 
   try        bmp.LoadFromFile(OpenPictureDialog1.FileName);       
Image1.Proportional := False;        Image1.Stretch := False;       
Image1.Picture.Bitmap.Assign(bmp);        Image1.Proportional :=
True;        Image1.Stretch := True;      finally        bmp.Free;   
 end;    end;end;

----------------------------------------------------------------------
shyub · 2023-10-06 07:24

The problem was solved this way:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
MyBmp.Canvas.StretchDraw(Classes.Rect(0, 0, MyBmp.Width,
MyBmp.Height), Bmp);