4

I need a little help...

I have a transparent PNG image in my application resources. Until now I was loading it in a TPngImage and draw it on the screen with Canvas.Draw(X, Y, PngImage);. And it was drawn transparently. Now I updated my application to be DpiAware and I need to scale all images. I need a quality resampler and I choose to use Graphics32. I managed to do the resampling but I don't know how to keep the transparecy... I try all that I cand think of... The result of the following code is the image drawn with black color in the transparent region...

Foto32, Buff: TBitmap32;
FotoPng: TPngImage;

constructor TForm.Create(AOwner: TComponent);
const BkgHeight = 380;
var Res: TKernelResampler;
    SRect, DRect: TRect;
    ImgWidth: Integer;
begin
 inherited;
 Buff:= TBitmap32.Create;
 Res:= TKernelResampler.Create;
 Res.Kernel:= TLanczosKernel.Create;

 FotoPng:= TPngImage.Create;
 FotoPng.Transparent:= True;
 FotoPng.TransparentColor:= clBlack;
 FotoPng.LoadFromResourceName(HInstance, 'BKG_FOTO');
 Foto32:= TBitmap32.Create;
 Foto32.DrawMode:= dmBlend;
 Foto32.CombineMode:= cmMerge;
 Foto32.OuterColor:= clBlack;
 Foto32.Canvas.Brush.Style:= bsClear;
 Foto32.SetSize(FotoPng.Width, FotoPng.Height);
 FotoPng.Draw(Foto32.Canvas, Rect(0, 0, FotoPng.Width, FotoPng.Height));

 ImgWidth:= Round(Real(Foto32.Width / Foto32.Height) * BkgHeight);
 SRect:= Rect(0, 0, Foto32.Width, Foto32.Height);
 Buff.DrawMode:= dmBlend;
 Buff.CombineMode:= cmMerge;
 Buff.OuterColor:= clBlack;
 Buff.Canvas.Brush.Style:= bsClear;
 Buff.SetSize(Scale(ImgWidth), Scale(BkgHeight));
 DRect:= Rect(0, 0, Buff.Width, Buff.Height);
 Res.Resample(Buff, DRect, DRect, Foto32, SRect, dmTransparent {dmBlend}, nil);
end;

procedure TForm.Paint;
begin
 // ....
 Buff.DrawTo(Canvas.Handle, X, Y);
end;

And this is my transparent PNG image compiled into resources: https://postimg.cc/3yy3wrJB

I found here a similar question, but I don't use the image with a TImage, I draw it directly on the canvas. And in the single answer, David says:

Anyway, if that is so, I would combine the transparency support of TImage with the re-sampling ability of TBitmap32 to build a solution that way. Keep the original image in a TBitmap32 instance. Whenever you need to load it into the TImage component, for example when re-sizing, use TBitmap32 to perform an in-memory re-size and load that re-sized image.

This is exactly what I'm trying to do, but I don't know why the transparecy is not working. Any ideas ?

Marcus Held
  • 635
  • 4
  • 15
Marus Gradinaru
  • 2,824
  • 1
  • 26
  • 55
  • Can you attach a picture of what is expected and the current problem?. I mean if the background of the image on the canvas is simple (solid single color) then why not fill the FOTO32 background first then draw the FOTOPNG on it then draw to the canvas?. – Nasreddine Galfout Jan 24 '20 at 23:17
  • The background of the canvas it's not solid, it has other drawings. – Marus Gradinaru Jan 24 '20 at 23:52
  • `FotoPng.Draw(Foto32.Canvas, ...` -> Once you draw the png, it is over. You can draw transparently but transparency information is lost there, drawing does not transfer alpha channel to the target. You need to resample the png itself. See [here](https://stackoverflow.com/questions/2437714/resize-png-image). – Sertac Akyuz Jan 29 '20 at 20:25
  • @SertacAkyuz I used that code and I get exception "Only COLOR_RGBALPHA and COLOR_RGB formats are supported"... because my png image is to big and I had to compres it with `pngquant'. :( – Marus Gradinaru Jan 29 '20 at 22:33
  • Would it be possible to decompres the `pngquant` to normal png in memory ? – Marus Gradinaru Jan 29 '20 at 23:19
  • No, a lossy transformation is irreversible. – Sertac Akyuz Jan 29 '20 at 23:43
  • Have you tried this ? : https://en.delphipraxis.net/topic/1954-high-quality-bitmap-resize-with-transparency/ – Marc Guillot Jan 30 '20 at 09:01
  • I tried... It's not a quality resize. It's too smooth and it have some artifacts on the edges. – Marus Gradinaru Jan 30 '20 at 11:41
  • @SertacAkyuz I don't want to make it lossless again, I just want tot change the format from `COLOR_PALETTE` (indexed pngquant) to `COLOR_RGBALPHA`. I think it should be possible but I am not really good at graphics in delphi.... – Marus Gradinaru Jan 30 '20 at 15:08
  • I suppose there might be libraries that could do that. Searching would be the way to go forward. ... I think I would explore the other way around: leave the resource RGBA. load to png image, resize it. Downsample bits per plane before drawing to reduce in-memory overhead... Perhaps it doesn't make sense, dunno. What difficulty are you having with the size of the png? – Sertac Akyuz Jan 30 '20 at 16:36
  • I cannot leave the resource RGBA, because it has 2,8 MB :)) It's half the size of the application... But if I use pngquant it is reduced to 0,9 MB. The png must be high resolution to look nice on high dpi displays. Not memory overhead it's my problem, but the exe file size... – Marus Gradinaru Jan 30 '20 at 17:59
  • Can you show us the PNG itself? I strongly suspect that you can save a 1-bit transparency mask before resizing, resize it separately and then just reapply it to the image. It may so happen it`s even possible to generate a similar image programmatically on the fly, which would make the image scale agnostic. – hidefromkgb Jan 30 '20 at 21:36
  • This is the PNG: https://postimg.cc/3yy3wrJB Click on the `Download original image` – Marus Gradinaru Jan 30 '20 at 22:38

1 Answers1

1

Your issue seems to be an issue with drawing the Buffer to the screen. Bitmap32 uses StretchDIBits for painting which ignores the alpha channel.

You could use the AlphaBlend function in order to draw your image:

procedure TForm1.FormPaint(Sender: TObject);
var
  BF: TBlendFunction;
begin
  BF.BlendOp := AC_SRC_OVER;
  BF.BlendFlags := 0;
  BF.SourceConstantAlpha := 255;
  BF.AlphaFormat := AC_SRC_ALPHA;

  Winapi.Windows.AlphaBlend(Canvas.Handle, 0, 0, Buff.Width, Buff.Height,
    Buff.Canvas.Handle, 0, 0, Buff.Width, Buff.Height, BF);
end;

Or convert your TBitmap32 to a Delphi TBitmap and paint that using the VCL:

procedure TForm1.FormPaint(Sender: TObject);
var
  Bmp: TBitmap;
  I: Integer;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf32bit;
    Bmp.AlphaFormat := afDefined;
    Bmp.SetSize(Buff.Width, Buff.Height);
    for I := 0 to Buff.Height - 1 do
      Move(Buff.ScanLine[I]^, Bmp.ScanLine[I]^, Buff.Width * 4);
    Canvas.Draw(0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;
Sebastian Z
  • 4,520
  • 1
  • 15
  • 30