TPicture conversion

[xinyiman]

Hello guys, a question. I have a TImage named img and people through LoadFromFile procedure. And up to now it all works. The problem is that I then have to make us of the elaboration and comfort I wish if I upload a jpg or png this is loaded in the bitmap. How can I do? So I would like to convert the flight jpg to bmp and png to bmp.

Ideas?

My actual code to import:

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

1. function TImgResize.LoadFromFile(filename: string): boolean;
2. var
3.    ret: boolean;
4. begin
5.           try
6.              try
7.  
8.                 img.Picture.LoadFromFile(filename);
9.  
10.                 ret:=true;
11.  
12.              finally
13.             end;
14.           except
15.                 on E: Exception do
16.                 begin
17.  
18.                    ret:=false;
19.  
20.                 end;
21.           end;
22.           result:=ret;
23. end;
24.  

[howardpc]

I'm not entirely clear what you want. But perhaps something like this is what you are after?

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

1. function LoadImageFromAnyFile(anImage: TImage; const aFilename: string): boolean;
2. var
3.   pic: TPicture;
4. begin
5.   Assert(FileExists(aFilename),'LoadImageFromAnyFile: non-exisistent file');
6.   Assert(anImage<>nil,'LoadImageFromAnyFile: image does not exist');
7.   pic:=TPicture.Create;
8.   try
9.     pic.LoadFromFile(aFilename);
10.     anImage.Picture.Assign(pic);
11.     Result:=not anImage.Picture.Bitmap.Empty;
12.   finally
13.     pic.Free;
14.   end;
15. end;  

[derek.john.evans]

EDIT: If all you want is the TBitmap, then you will find the TBitmap in TPicture. ie: if you load a JPEG/PNG, you access the TBitmap from TPicture. or, vice-versa. ie: If you load a bmp, you can save out jpeg. All that is already in TPicture.

The TPicture object in TImage will aready handle PNG, JPEG & BMP, so there is no need for conversion.

Im guessing, since you said "upload", that you want a function which will handle local and remote loading.

If so, then something like this:

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

1. uses StrUtils, fphttpclient;
2.  
3. procedure PictureLoadFromUrl(const APicture: TPicture; const AUrl: string);
4. var
5.   LStream: TStream;
6. begin
7.   if AnsiStartsText('http://', AUrl) then begin
8.     LStream := TMemoryStream.Create;
9.     try
10.       TFPHTTPClient.SimpleGet(AUrl, LStream);
11.       LStream.Position := 0;
12.       APicture.LoadFromStream(LStream);
13.     finally
14.       FreeAndNil(LStream);
15.     end;
16.   end else begin
17.     APicture.LoadFromFile(AUrl);
18.   end;
19. end;  
20.  

Note, this doesn't handle download progress. Todo that, I create a  inherited TMemoryStream class which overrides TStream.Write(). This will allow you to monitor the size of the stream as its downloaded.

[xinyiman]

Let's try an example, so we understand each other better. If you try to compile and to run the test source that I have attached. You will see that if I press the button 1 the TImge remains black, if you press the button 2 you will see that an image appears.

What I wonder is where I'm wrong if the TImage automatically take care of the automatic conversion as you say.

Download the source then you loaded into a jpg file and rename "a.jpg" Then we loaded into a bmp file and rename "a.bmp"

Notice that you must have loaded the BGRAControls to fill.

[Michl]

For me the result is the same. Button1 and Button2 shows a image (64bit Windows7, 32bit Lazarus trunk, FPC trunk). Maybe you can post your jpg here too, maybe this buggy?!

[xinyiman]

My jpeg

[Michl]

Your example is also running with Windows7, 32bit and 64bit Lazarus 1.6.
Your example failed here too on Linux Mint GKT2 64bit and 32bit Lazarus 1.6.

Just a side question. Why don't you use BGRABitmap as a package? Iit wasn't in the dependency.

[Edit]
If you remove

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

1.     if app.ResizeImage(100,100) then      

it run fine on Linux. I'll have a look.

[xinyiman]

Your example is also running with Windows7, 32bit and 64bit Lazarus 1.6.
Your example failed here too on Linux Mint GKT2 64bit and 32bit Lazarus 1.6.

Just a side question. Why don't you use BGRABitmap as a package? Iit wasn't in the dependency.

[Edit]
If you remove

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

1.     if app.ResizeImage(100,100) then      

it run fine on Linux. I'll have a look.

Ok, but then how do I resize? And then I'm interested to export to file the contents of the bitmap after having resized. Suggestions?

[Michl]

One solution, working without BGRABitmap is:

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

1. function TImgResize.ResizeImage(AWidth: integer; AHeight: integer): boolean;
2. var
3.    ret: boolean;
4. //   Bitmap: TBGRABitmap;      
5.    Bitmap: TBitmap;
6. begin
7.           try
8.              try
9.  
10.                 //AWidth:img.Picture.Bitmap.Width=AHeight:img.Picture.Bitmap.Height
11.                 if AWidth>AHeight then
12.                 begin
13.                      //è più largo che alto quindi devo ricalcolare l'altezza in proporzione
14.                      AHeight:=Trunc((AWidth*img.Picture.Bitmap.Height)/img.Picture.Bitmap.Width)
15.                 end else begin
16.                    //è più lungo che largo quindi devo ricalcolare la larghezza in proporzione
17.                    AWidth:=Trunc((img.Picture.Bitmap.Width*AHeight)/img.Picture.Bitmap.Height)
18.                 end;
19.  
20.                 Bitmap:=TBitmap.Create;
21.                 Bitmap.SetSize(AWidth, AHeight);
22.                 Bitmap.Canvas.StretchDraw(Rect(0, 0, AWidth, AHeight), img.Picture.Bitmap);
23. //                Bitmap:=TBGRABitmap.Create(AWidth, AHeight);
24. //                Bitmap.Assign(img.Picture.Bitmap);
25. //                BGRAReplace(Bitmap, Bitmap.Resample(AWidth, AHeight));
26.                 img.Picture.Bitmap.Assign(Bitmap);
27.                 Bitmap.Free;
28.                 ret:=true;
29.  
30.              finally
31.                     //codice da effettuare a fine procedura sia che va bene il codice sopra sia che il codice ha sollevato un'eccezzione
32.             end;
33.           except
34.                 on E: Exception do
35.                 begin
36.  
37.                    //codice da eseguire solo se si verifica un eccezzione
38.                    ret:=false;
39.  
40.                 end;
41.           end;
42.           result:=ret;
43. end;

I'll try to find the reason for BGRABitmap.

[xinyiman]

One solution, working without BGRABitmap is:

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

1. function TImgResize.ResizeImage(AWidth: integer; AHeight: integer): boolean;
2. var
3.    ret: boolean;
4. //   Bitmap: TBGRABitmap;      
5.    Bitmap: TBitmap;
6. begin
7.           try
8.              try
9.  
10.                 //AWidth:img.Picture.Bitmap.Width=AHeight:img.Picture.Bitmap.Height
11.                 if AWidth>AHeight then
12.                 begin
13.                      //è più largo che alto quindi devo ricalcolare l'altezza in proporzione
14.                      AHeight:=Trunc((AWidth*img.Picture.Bitmap.Height)/img.Picture.Bitmap.Width)
15.                 end else begin
16.                    //è più lungo che largo quindi devo ricalcolare la larghezza in proporzione
17.                    AWidth:=Trunc((img.Picture.Bitmap.Width*AHeight)/img.Picture.Bitmap.Height)
18.                 end;
19.  
20.                 Bitmap:=TBitmap.Create;
21.                 Bitmap.SetSize(AWidth, AHeight);
22.                 Bitmap.Canvas.StretchDraw(Rect(0, 0, AWidth, AHeight), img.Picture.Bitmap);
23. //                Bitmap:=TBGRABitmap.Create(AWidth, AHeight);
24. //                Bitmap.Assign(img.Picture.Bitmap);
25. //                BGRAReplace(Bitmap, Bitmap.Resample(AWidth, AHeight));
26.                 img.Picture.Bitmap.Assign(Bitmap);
27.                 Bitmap.Free;
28.                 ret:=true;
29.  
30.              finally
31.                     //codice da effettuare a fine procedura sia che va bene il codice sopra sia che il codice ha sollevato un'eccezzione
32.             end;
33.           except
34.                 on E: Exception do
35.                 begin
36.  
37.                    //codice da eseguire solo se si verifica un eccezzione
38.                    ret:=false;
39.  
40.                 end;
41.           end;
42.           result:=ret;
43. end;

I'll try to find the reason for BGRABitmap.

Thank you very much

[Michl]

The reason is

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

1. Bitmap.Resample(AWidth, AHeight);

doesn't work on Linux GTK2.

[Michl]

@xinyiman: Just a side note. If a exception is rised, your Bitmap isn't freed. It's better to free it in finally.

[xinyiman]

Ok thanks 

[Michl]

@xinyiman: Your first program should run now, if you update BGRABitmap to the current trunk. See http://forum.lazarus.freepascal.org/index.php/topic,33746

[xinyiman]

@xinyiman: Your first program should run now, if you update BGRABitmap to the current trunk. See http://forum.lazarus.freepascal.org/index.php/topic,33746

Thanks