Recent

Author Topic: TFPMemoryImage assigned to TImage.Picture don't displaying  (Read 2340 times)

Awkward

  • Jr. Member
  • **
  • Posts: 95
TFPMemoryImage assigned to TImage.Picture don't displaying
« on: September 09, 2021, 11:35:07 pm »
I use next function to show picture file from memory. It can work for JPG or PNG but not DDS. if i will uncomment "SaveToFile" line, i will get proper PNG file. but impgPreview (TImage control) after assigning still empty. What i doing wrong?

Code: Pascal  [Select][+][-]
  1. procedure TRGGUIForm.PreviewImage(const aname:string);
  2. var
  3.   limg:TFPMemoryImage;
  4.   lstr:TMemoryStream;
  5.   lfpc:TFPColor;
  6.   ldata:PByte;
  7.   lidx,y,x,lsize,lheight,lwidth:integer;
  8. begin
  9.   if ExtractFileExt(aname)='.DDS' then
  10.   begin
  11.     LoadDDSImage(FUData,MemSize(FUData),ldata,lwidth,lheight);
  12.  
  13.     limg:=TFPMemoryImage.Create(lwidth,lheight);
  14.     lidx:=0;
  15.     for y:=0 to lheight-1 do
  16.     begin
  17.       for x:=0 to lwidth-1 do
  18.       begin
  19.         lfpc.Red  :=ldata[lidx+0] shl 8;
  20.         lfpc.Green:=ldata[lidx+1] shl 8;
  21.         lfpc.Blue :=ldata[lidx+2] shl 8;
  22.         lfpc.Alpha:=ldata[lidx+3];
  23.         limg.Colors[x,y]:=lfpc;
  24.         inc(lidx,4);
  25.       end;
  26.     end;
  27.     FreeMem(ldata);
  28. {  if i will use next 2 lines, picture displaying
  29.     limg.SaveToFile('d:\112.png');
  30.     imgPreview.Picture.LoadFromFile('d:\112.png');
  31. }
  32.     imgPreview.Picture.Assign(limg);
  33.     limg.Free;
  34.   end
  35.   else
  36.   begin
  37.     lstr:=TMemoryStream.Create();
  38.     try
  39.       lstr.SetBuffer(FUData);
  40.       imgPreview.Picture.LoadFromStream(lstr);
  41.     finally
  42.       lstr.Free;
  43.     end;
  44.   end;
  45.   imgPreview.Visible:=true;
  46. end;
  47.  

Remy Lebeau

  • Hero Member
  • *****
  • Posts: 1021
    • Lebeau Software
Re: TFPMemoryImage assigned to TImage.Picture don't displaying
« Reply #1 on: September 10, 2021, 12:11:37 am »
Code: Pascal  [Select][+][-]
  1. {  if i will use next 2 lines, picture displaying
  2.     limg.SaveToFile('d:\112.png');
  3.     imgPreview.Picture.LoadFromFile('d:\112.png');
  4. }

Have you tried using limg.SaveToStream() followed by imgPreview.Picture.LoadFromStream()?  You should not need to use a temp file at all, but you do need to still pick an image format (JPG, PNG, etc) for the TFPMemoryImage data to be converted to for display.

Try this:

Code: Pascal  [Select][+][-]
  1. procedure TRGGUIForm.PreviewImage(const aName: string);
  2. var
  3.   limg: TFPMemoryImage;
  4.   lstr: TMemoryStream;
  5.   lfpc: TFPColor;
  6.   ldata: PByte;
  7.   lidx, y, x, lsize, lheight, lwidth: Integer;
  8.   lwriter: TFPWriterPNG;
  9. begin
  10.   if ExtractFileExt(aName) = '.DDS' then
  11.   begin
  12.     LoadDDSImage(FUData, MemSize(FUData), ldata, lwidth, lheight);
  13.     try
  14.       limg := TFPMemoryImage.Create(lwidth, lheight);
  15.       try
  16.         lidx := 0;
  17.         for y := 0 to lheight-1 do
  18.         begin
  19.           for x := 0 to lwidth-1 do
  20.           begin
  21.             lfpc.Red := ldata[lidx+0] shl 8;
  22.             lfpc.Green := ldata[lidx+1] shl 8;
  23.             lfpc.Blue := ldata[lidx+2] shl 8;
  24.             lfpc.Alpha := ldata[lidx+3];
  25.             limg.Colors[x, y] := lfpc;
  26.             Inc(lidx, 4);
  27.           end;
  28.         end;
  29.         FreeMem(ldata);
  30.         ldata := nil;
  31.         lstr := TMemoryStream.Create;
  32.         try
  33.           lwriter := TFPWriterPNG.Create;
  34.           try
  35.             limg.SaveToStream(lstr, lwriter);
  36.             // or: lwriter.ImageWrite(lstr, limg);
  37.           finally
  38.             lwriter.Free;
  39.           end;
  40.           lstr.Position := 0;
  41.           imgPreview.Picture.LoadFromStream(lstr);
  42.         finally
  43.           lstr.Free;
  44.         end;
  45.       finally
  46.         limg.Free;
  47.       end;
  48.     finally
  49.       if ldata <> nil then
  50.         FreeMem(ldata);
  51.     end;
  52.   end
  53.   else
  54.   begin
  55.     lstr := TMemoryStream.Create;
  56.     try
  57.       lstr.SetBuffer(FUData);
  58.       imgPreview.Picture.LoadFromStream(lstr);
  59.     finally
  60.       lstr.Free;
  61.     end;
  62.   end;
  63.   imgPreview.Visible := true;
  64. end;
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) - Admin, Developer (Support forum)

Awkward

  • Jr. Member
  • **
  • Posts: 95
Re: TFPMemoryImage assigned to TImage.Picture don't displaying
« Reply #2 on: September 10, 2021, 08:23:13 am »
i know this method, didn't tried it (and i think, it will work). But i wandered and want to know, why direct assign don't work.

wp

  • Hero Member
  • *****
  • Posts: 9040
Re: TFPMemoryImage assigned to TImage.Picture don't displaying
« Reply #3 on: September 10, 2021, 11:05:20 am »
Not 100% sure, but AFAIK TFPMemoryImage only provides a buffer for the image, but no information how the data in the buffer will have to be organized in the destination image format.

I'd use a TLazIntfImage instead which provides a simpler interface to the classes of the graphics units. A png image, for example, can loaded from a LazIntfImage and thus set its required memory layout.

Untested:

Code: Pascal  [Select][+][-]
  1. uses
  2.   IntfGraphics, fpimage;
  3.  
  4. procedure TForm1.Button1Click(Sender: TObject);
  5. var
  6.   img: TLazIntfImage;
  7.   png: TCustomBitmap;
  8.   lHeight, lWidth: Integer;
  9.   lData: PByte;
  10. begin
  11.   LoadDDSImage(FUData, MemSize(FUData), ldata, lwidth, lheight);
  12.   try
  13.     png := TPortableNetworkgraphic.Create; // or TJpegImage.Create, or TBitmap.Create, or ...
  14.     try
  15.       png.SetSize(lWidth, lHeight);
  16.       png.PixelFormat := pf32bit;
  17.       img := png.CreateIntfImage;
  18.       try
  19.         for y := 0 to lheight-1 do
  20.         begin
  21.           for x := 0 to lwidth-1 do
  22.           begin
  23.             lfpc.Red := ldata[lidx+0] shl 8;
  24.             lfpc.Green := ldata[lidx+1] shl 8;
  25.             lfpc.Blue := ldata[lidx+2] shl 8;
  26.             lfpc.Alpha := ldata[lidx+3];
  27.             limg.Colors[x, y] := lfpc;
  28.             Inc(lidx, 4);
  29.           end;
  30.         end;
  31.         png.LoadFromIntfImage(img);
  32.         imgPreview.Picture.Assign(png);
  33.       finally
  34.         img.Free;
  35.       end;
  36.     finally
  37.       png.Free;
  38.     end;
  39.   finally
  40.     FreeMem(lData);
  41.   end;
  42. end;
  43.  
« Last Edit: September 10, 2021, 11:07:50 am by wp »
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

Awkward

  • Jr. Member
  • **
  • Posts: 95
Re: TFPMemoryImage assigned to TImage.Picture don't displaying
« Reply #4 on: September 11, 2021, 06:25:22 pm »
Not 100% sure, but AFAIK TFPMemoryImage only provides a buffer for the image, but no information how the data in the buffer will have to be organized in the destination image format.

I'd use a TLazIntfImage instead which provides a simpler interface to the classes of the graphics units. A png image, for example, can loaded from a LazIntfImage and thus set its required memory layout.

you forgot to rename "limg" to "img" at one place and initialize "lidx" by 0 at another.
well, picture displayed but on plack background (like no alpha)

wp

  • Hero Member
  • *****
  • Posts: 9040
Re: TFPMemoryImage assigned to TImage.Picture don't displaying
« Reply #5 on: September 11, 2021, 07:57:44 pm »
Since I don't have neither your LoadDDSImage procedure nor a DDS image for testing, I simulated the procedure by the Lazarus paw which is read into a png, and I use the IntfImage to color the black paw in red and replace the alpha-channel by a gradient from fully transparent at the left to fully opaque white at the right. Look at the attached demo. It works as expected.

If this basic code does not work in your example you should check whether the color and alpha channels are handled correctly. FPImage uses 16-bit colors and alpha. This is why you shl the rgb value by 8 bits. But you do not shl the alpha channel. I do not know if this explains why your image background is black.
Mainly Lazarus trunk / fpc 3.2.0 / all 32-bit on Win-10, but many more...

 

TinyPortal © 2005-2018