How to completely disable transparency of given PNGObject? By the way I am using PNGImage unit of Version 1.564.
I don't think it's possible to permanently disable TPNGObject image transparency. Or at least I couldn't find a property for doing this. And it should have been controlled by a property since when you assign or load an image, the TPNGObject takes the image parameters (including transparency) from the image file assigned.
So as a workaround I would prefer to use the RemoveTransparency procedure after when you load or assign the image:
uses
PNGImage;
procedure TForm1.Button1Click(Sender: TObject);
var
PNGObject: TPNGObject;
begin
PNGObject := TPNGObject.Create;
try
PNGObject.LoadFromFile('C:\Image.png');
PNGObject.RemoveTransparency;
PNGObject.Draw(Canvas, Rect(0, 0, PNGObject.Width, PNGObject.Height));
finally
PNGObject.Free;
end;
end;
For just drawing a TPNGObject (Delphi PNGComponents library) to some background color (in example: white) with alpha blending, try this:
uses
PNGImage, PNGFunctions;
procedure TForm1.Button1Click(Sender: TObject);
var png: TPNGObject;
bmp: TBitmap;
begin
try
// load PNG
png := TPNGObject.Create;
png.LoadFromFile('MyPNG.png');
// create Bitmap
bmp := TBitmap.Create;
bmp.Width := png.Width;
bmp.Height := png.Height;
// set background color to whatever you want
bmp.Canvas.Brush.Color := clWhite;
bmp.Canvas.FillRect(Rect(0, 0, png.Width, png.Height));
// draw PNG on Bitmap with alpha blending
DrawPNG(png, bmp.Canvas, Rect(0, 0, png.Width, png.Height), []);
// save Bitmap
bmp.SaveToFile('MyBMP.bmp');
finally
FreeAndNil(png);
FreeAndNil(bmp);
end;
end;
To use the DrawPNG procedure you have to include the PNGFunctions unit.
Related
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 ?
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;
I'm using Delphi's TPngImage class to convert BMP images (TBitmap) to PNG, by assigning the respective TBitmap object with the bitmap image in it, to the freshly created TPngImage object.
I need to set the color type to COLOR_PALETTE to create an Indexed RGB PNG.
I didn't manage to find any property of the TPngImage class that can do it.
Can anyone help me?
You can specify color type in the CreateBlank constructor and instead of assigment simply flush the bitmap on the PNG image canvas. For example:
var
R: TRect;
Bmp: TBitmap;
Png: TPngImage;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('C:\Source.bmp');
Png := TPngImage.CreateBlank(COLOR_PALETTE, 8, Bmp.Width, Bmp.Height);
try
R := Rect(0, 0, Bmp.Width, Bmp.Height);
Png.Canvas.CopyRect(R, Bmp.Canvas, R);
Png.SaveToFile('C:\Target.png');
finally
Png.Free;
end;
finally
Bmp.Free;
end;
end;
I have a TBitmap, inside the TBitmap there is load a "map image" (image of a map). This map image have a white background and a lot of black line (no antialising only 2 colors white background and black line).
Now I must do this:
Remove the white background from TBitmap (transparent background and black line);
If possible and only if possible replace black line color with another color;
Save the result as trasparent PNG image;
I don't have idea if these are possible.
Suggestions?
NOTE I want avoid to use 3th part of class or VCL if possible. I can use FreeImage library if need because I just use it on my project. I use Delphi XE3.
Change pixelformat to pf1Bit. Create a palette with 2 entries, change the values of the TPaletteEntry to the desired color value (in the shown exaple to red). Create a TPNGImage, assign the bitmap and set the transparency for the PNG.
implementation
uses pngimage;
{$R *.dfm}
Type
TMyPalette = Packed Record
palVersion : Word;
palNumEntries : Word;
palPalEntry : Array [0..1] of TPaletteEntry;
End;
Procedure ChangeBlackColor(bmp:TBitMap);
var
pal:TMyPalette;
begin
bmp.PixelFormat := pf1Bit;
bmp.HandleType := bmDIB;
With pal Do
Begin
palVersion:=$0300;
palNumEntries:=2;
palPalEntry[0].peRed:= $FF;
palPalEntry[0].peGreen:=$00;
palPalEntry[0].peBlue:= $00;
palPalEntry[0].peFlags:=PC_RESERVED;
palPalEntry[1].peRed:= $FF;
palPalEntry[1].peGreen:=$FF;
palPalEntry[1].peBlue:= $FF;
palPalEntry[1].peFlags:=PC_RESERVED;
End;
bmp.Palette := CreatePalette(pLogPalette(#pal)^)
end;
procedure TForm3.Button1Click(Sender: TObject);
var
png:TPngimage;
bmp:TBitmap;
begin
// sample image
Image1.Canvas.Rectangle(0,0,Image1.Width-1,Image1.Height-1);
Image1.Canvas.Ellipse(1,1,Image1.Width,Image1.Height);
bmp := Image1.Picture.Bitmap;
ChangeBlackColor(bmp);
png:=TPngimage.Create;
try
png.Assign(bmp);
png.TransparentColor := clWhite;
png.Transparent := true;
Image2.Picture.Assign(png);
finally
png.Free;
end;
end;
I am building an application that has "virtual windows". The output is TImage object.
1) The application loads window skin files into TPNGObject's:
2) Then application has to create a new blank TPNGObject, and resize the skin files to needed sizes and draw them on that blank image. Should look something like this:
3) And the final output on TImage:
The problem is that I do know how to create a completely blank off screen image. Of course I could simply render the skin files on to TImage each time, but it's easier and better to resize skin files and create the window once, instead.
I'm using the PNG Library by Gustavo Daud, version 1.564 (31st July, 2006).
The below uses CreatePNG procedure of 'pngfunctions.pas' of Martijn Sally, from an extension library (pngcomponents) to pngimage.
var
Bmp, Mask: TBitmap;
PNG: TPNGObject;
begin
Bmp := TBitmap.Create;
Bmp.PixelFormat := pf24bit;
Bmp.SetSize(64, 64);
Bmp.Canvas.Brush.Color := clBtnFace;
Bmp.Canvas.Font.Color := clRed;
Bmp.Canvas.Font.Size := 24;
Bmp.Canvas.TextOut(4, 10, 'text');
Mask := TBitmap.Create;
Mask.PixelFormat := pf24bit;
Mask.Canvas.Brush.Color := clBlack;
Mask.SetSize(64, 64);
Mask.Canvas.Font.Color := clWhite;
Mask.Canvas.Font.Size := 24;
Mask.Canvas.TextOut(4, 10, 'text');
PNG := TPNGObject.Create;
CreatePNG(Bmp, Mask, PNG, False);
PNG.Draw(Canvas, Rect(10, 10, 74, 74));
// finally, free etc...
Here's the output (black, white squares are TShapes):
My other answer is another alternative which I suggest. However your question still poses an issue: The PNG library must either have a bug which is preventing any canvas drawing from being visible (after using CreateBlank constructor with COLOR_RGBALPHA as color type) or we're all missing something.
It looks like the only workaround that I can see is (as you mention in your edit) use a Bitmap to do your drawing instead. Use the transparent properties of this bitmap (Transparent: Bool and TransparentColor: TColor) to set up the transparent area of your image, then when you need a transparent PNG, just copy that bitmap over to the new PNG object...
BMP.Width:= 100;
BMP.Height:= 100;
BMP.Transparent:= True;
BMP.TransparentColor:= clWhite;
BMP.Canvas.Brush.Style:= bsSolid;
BMP.Canvas.Brush.Color:= clWhite;
BMP.Canvas.FillRect(BMP.Canvas.ClipRect);
BMP.Canvas.Brush.Color:= clBlue;
BMP.Canvas.Ellipse(10, 10, 90, 90);
PNG.Assign(BMP);
And the white area of the image should be transparent. There are other ways of accomplishing the transparent area, but that's another subject.
Image:
Is this what you're trying to do?
I apologize to people that I messed their heads up.
It turns out CreateBlank works as wanted. The problem was that I was drawing PNG on PNG canvas (PNG.Canvas.Draw). Canvas doesn't really support transparency. To draw a translucent PNG on another PNG you will need a procedure/function that merges those both layers together. With some googling I ended up with this procedure:
procedure MergePNGLayer(Layer1, Layer2: TPNGObject; Const aLeft, aTop: Integer);
var
x, y: Integer;
SL1, SL2, SLBlended: pRGBLine;
aSL1, aSL2, aSLBlended: PByteArray;
blendCoeff: single;
blendedPNG, Lay2buff: TPNGObject;
begin
blendedPNG := TPNGObject.Create;
blendedPNG.Assign(Layer1);
Lay2buff:=TPNGObject.Create;
Lay2buff.Assign(Layer2);
SetPNGCanvasSize(Layer2, Layer1.Width, Layer1.Height, aLeft, aTop);
for y := 0 to Layer1.Height - 1 do
begin
SL1 := Layer1.Scanline[y];
SL2 := Layer2.Scanline[y];
aSL1 := Layer1.AlphaScanline[y];
aSL2 := Layer2.AlphaScanline[y];
SLBlended := blendedPNG.Scanline[y];
aSLBlended := blendedPNG.AlphaScanline[y];
for x := 0 to Layer1.Width - 1 do
begin
blendCoeff:=aSL1[x] * 100/255/100;
aSLBlended[x] := round(aSL2[x] + (aSL1[x]-aSL2[x]) * blendCoeff);
SLBlended[x].rgbtRed := round(SL2[x].rgbtRed + (SL1[x].rgbtRed-SL2[x].rgbtRed) * blendCoeff);
SLBlended[x].rgbtGreen := round(SL2[x].rgbtGreen + (SL1[x].rgbtGreen-SL2[x].rgbtGreen) * blendCoeff);
SLBlended[x].rgbtBlue := round(SL2[x].rgbtBlue + (SL1[x].rgbtBlue-SL2[x].rgbtBlue) * blendCoeff);
end;
end;
Layer1.Assign(blendedPNG);
Layer2.Assign(Lay2buff);
blendedPNG.Free;
Lay2buff.Free;
end;
Usage:
var
PNG1, PNG2: TPNGObject;
begin
PNG1 := TPNGObject.CreateBlank(COLOR_RGBALPHA, 16, 500, 500);
PNG2 := TPNGObject.Create;
PNG2.LoadFromFile('...*.png');
MergePNGLayer(PNG1, PNG2, 0, 0);
// PNG1 is the output
And again, I am really sorry to users that wanted to help, but couldn't due to not understanding me.
I don't have answer to this question but I figured out how to get same result with any PNG editor. I have created blank 1000x1000 PNG image and saved it in my application directory. Then I open this image in my program and resize image to needed sizes (smaller of course) and that's the trick.
Problem in drawing a semi transparent PNG image on TBitmap object.
If the TBitmap's ,HandleType is set to bmDDB, then the canvas is drawn transparent.
But the problem is it doesn't work on all kinds of machines (for ex: Windows on apple computers).
When a TBitmap's HandleType property is set to bmDIB, canvas background is drawn white.
bmp.HandleType := bmDIB;
I tried setting Brush style to bsClear. But it draws the transparent pixels in black color.
How can I draw an image preserving its transparency and smooth curved edges.
Thanks
Pavan.
It is certainly possible to paint a bmDIB bitmap with transparent background to a canvas:
procedure TForm1.FormPaint(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32bit;
Bmp.HandleType := bmDIB;
Bmp.Width := 700;
Bmp.Height := 400;
Bmp.Transparent := TRUE;
Bmp.TransparentColor := clMaroon;
with Bmp.Canvas do begin
Brush.Color := clMaroon;
FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
Brush.Color := clBlue;
FillRect(Rect(42, 42, 200, 300));
end;
Canvas.Draw(12, 12, Bmp);
finally
Bmp.Free;
end;
end;
Note that the whole bitmap is filled first with the colour set as TransparentColor.
But for more control and speed you should look into a solution that is not as dependent on the GDI (which involves graphics card and driver capabilities), something like Graphics32.