For example, we have a base image in jpg format:
base jpg
And the overlay image in png format:
transparent png
This image I want to get as a result of their merger:
My question is: how to get this result using the power of TWICImage?
I can load both images like this:
function DoMerge: TWICImage;
var
wicJPG,
wicPNG: TWICImage;
begin
wicJPG := TWICImage.Create;
wicPNG := TWICImage.Create;
try
wicJPG.LoadFromFile('base.jpg');
wicPNG.LoadFromFile('overlay.png');
Result := wicJPG + wicPNG; // (pseudo-code) how?
finally
wicPNG.Free;
wicJPG.Free;
end;
end;
I know nothing about TWICImage except that its a TGraphic descendant.
So you can try something like this:
var
B: TBitmap;
B := TBitmap.Create;
try
B.Assign(wicJPG);
B.Canvas.Draw(0, 0, wicPNG);
Result := TWICImage.Create;
Result.Assign(B);
finally
B.Free;
end;
I can't test it now.
Related
I use this code to draw a image and save it as TIFF with Delphi 2006:
var Bmp: TBitmap;
MF: TMetaFile;
MetafileCanvas: TMetafileCanvas;
begin
Gdip := TGDIPlusFull.Create('gdiplus.dll');
MF := TMetaFile.Create;
MF.Width := 1000;
MF.Height := 1100;
MetafileCanvas := TMetafileCanvas.Create(MF, 0);
MetafileCanvas.Brush.Color := clRed;
MetafileCanvas.Brush.Style := bsDiagCross;
MetafileCanvas.Ellipse(50, 50, 300 - 50, 200 - 50);
MetafileCanvas.Free;
Bmp := Gdip.DrawAntiAliased(MF);
Image1.Picture.Assign(Bmp);
SynGDIPlus.SaveAs(Bmp, 'c:\test.tif', gptTIF);
Bmp.Free;
MF.Free;
FreeAndNil(GdiP);
end;
NOTE I use free framework fromhttp://www.synopse.info.
The code works very well. However I have a problem. How can I set the TIFF resolution.
My test.tif image have 96 DPI (screen resoltion), but I need of 200 DPI.
Note I cannot want change the image dimensions (width and heght), becuase there are right, I want change only DPI resolution.
I have found many answer about this question but nothing about Delphi.
I've added the following method:
procedure TSynPicture.BitmapSetResolution(DPI: single);
begin
if (fImage<>0) and fAssignedFromBitmap and (DPI<>0) then
Gdip.BitmapSetResolution(fImage,DPI,DPI);
end;
Which will call the corresponding GDI+ API for setting a bitmap resolution.
Then it should be specified when saving:
procedure SaveAs(Graphic: TPersistent; const FileName: TFileName;
Format: TGDIPPictureType; CompressionQuality: integer=80;
MaxPixelsForBiggestSide: cardinal=0; BitmapSetResolution: single=0); overload;
var Stream: TStream;
begin
Stream := TFileStream.Create(Filename, fmCreate);
try
SaveAs(Graphic,Stream,Format,CompressionQuality,MaxPixelsForBiggestSide,
BitmapSetResolution);
finally
Stream.Free;
end;
end;
So you could be able to write in your code:
Bmp := Gdip.DrawAntiAliased(MF);
Image1.Picture.Assign(Bmp);
SynGDIPlus.SaveAs(Bmp, 'c:\test.tif', gptTIF, 80, 0, 200); // force 200 DPI
Bmp.Free;
See this commit.
TWICImage class is able to save DPI information for TIF files, but the access to this feature is not apparent at first glance. Just call the SetResolution function of the Handle.
tif := TWICImage.Create;
...
tif.Handle.SetResolution( DPI_X, DPI_Y);
I am trying to load jpg into an imagelist by converting the .jpg to a bmp and then saving it to imagelist1.
From top to bottom of the code snip.
The Selectdir works and fileexists parts work. This is used to load in all the Images in a folder.All images are named like so 0.jpg / 1.jpg ect..
I then load the jpg to a tpicture. Set the bmp width /height and load the bmp with same image as jpg , i then add the bmp to the imagelist. And when its done it should show the first image 0.jpg
Two issues, first if i did it like so it would only show a small area (top left) of the bmp
but it was the correct image. I assume this is due to the option crop. which i cant seem to figure out how to make it select center during runtime?
Second, If i put
Imagelist1.width := currentimage.width;
Imagelist1.height := currentimage.height;
Then it shows last image. like Imagelist1.GetBitmap() did not work?
so i assume a fix for either one would be great!
cheers
squills
procedure TForm1.Load1Click(Sender: TObject);
var
openDialog : TOpenDialog;
dir :string;
MyPicture :TPicture;
currentimage :Tbitmap;
image : integer;
clTrans : TColor;
begin
Image := 0 ;
//lets user select a dir
SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP);
myPicture :=Tpicture.Create;
currentimage := TBitmap.Create;
//keeps adding images as long as the file path exsist.
//thus comic pages should be renumbed to 0-XX
while FileExists(Dir+'\'+inttostr(image)+'.jpg') do
begin
try
MyPicture.LoadFromFile(Dir+'\'+inttostr(image)+'.jpg'); //load image to jpg holder
currentimage.Width := mypicture.Width; //set width same as jpg
currentimage.Height:= mypicture.Height; //set height same as jpg
currentimage.Canvas.Draw(0, 0, myPicture.Graphic); //draw jpg on bmp
clTrans:=currentimage.TransparentColor; //unknown if needed?
//Imagelist1.Width := currentimage.Width;
//imagelist1.Height := currentimage.Height;
Imagelist1.Addmasked(Currentimage,clTrans); //add to imagelist
finally
image := image +1; //add one so it adds next page
end;
end;
ImageList1.GetBitmap(0,zImage1.Bitmap);
mypicture.Free;
currentimage.Free;
end;
You're adding a lot of unnecessary overhead by using the TImage every time.
Try something like this (untested, because I don't have a folder full of images named this way - it compiles, though <g>). You'll need to add Jpeg to your implementation uses clause if it's not already there, of course.
procedure TForm2.Button1Click(Sender: TObject);
var
DirName: string;
begin
DirName := 'D:\Images';
if SelectDirectory('Select Image Path',
'D:\TempFiles',
DirName,
[sdNewUI],
Self) then
LoadImages(DirName);
end;
procedure TForm2.LoadImages(const Dir: string);
var
i: Integer;
CurFileName: string;
JpgIn: TJPEGImage;
BmpOut: TBitmap;
begin
i := 1;
while True do
begin
CurFileName := Format('%s%d.jpg',
[IncludeTrailingPathDelimiter(Dir), i]);
if not FileExists(CurFileName) then
Break;
JpgIn := TJPEGImage.Create;
try
JpgIn.LoadFromFile(CurFileName);
// If you haven't initialized your ImageList width and height, it
// defaults to 16 x 16; we can set it here, if all the images are
// the same dimensions.
if (ImageList1.Count = 0) then
ImageList1.SetSize(JpgIn.Width, JpgIn.Height);
BmpOut := TBitmap.Create;
try
BmpOut.Assign(JpgIn);
ImageList1.Add(BmpOut, nil);
finally
BmpOut.Free;
end;
finally
JpgIn.Free;
end;
Inc(i);
end;
if ImageList1.Count > 0 then
begin
BmpOut := TBitmap.Create;
try
ImageList1.GetBitmap(0, BmpOut);
Image1.Picture.Assign(BmpOut);
finally
BmpOut.Free;
end;
end;
end;
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.
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.
I have a table contains Image in a Picture field and I am going to put them into an ImageList.
Here is the code:
ImageList.Clear;
ItemsDts.First;
ImageBitmap:= TBitmap.Create;
try
while not ItemsDts.Eof do
begin
if not ItemsDtsPicture.IsNull then
begin
ItemsDtsPicture.SaveToFile(TempFileBitmap);
ImageBitmap.LoadFromFile(TempFileBitmap);
ImageList.Add(ImageBitmap, nil);
end;
ItemsDts.Next;
end;
finally
ImageBitmap.Free;
end;
But I have some problem for images with difference size from ImageList size.
Update:
My problem is that when adding Image larger than ImageList size (32 * 32), for example 100 * 150 It does not appear correctly in a component connected to ImageList (for example in a ListView).
It seems newly added image is not stretched but is Croped. I want new image to be stretched as in ImageList Editor.
I don't know if ImageList provides a property to automatically stretch the image. Unless someone finds some built-in, you can always stretch the image yourself before adding it to the ImageList. And while you're at it, stop using the file-on-disk: use a TMemoryStream instead. Something like this:
var StretchedBMP: TBitmap;
MS: TMemoryStream;
ImageList.Clear;
ItemsDts.First;
StretchedBMP := TBitmap.Create;
try
// Prepare the stretched bmp's size
StretchedBMP.Width := ImageList.Width;
StretchedBMP.Height := ImageList.Height;
// Prepare the memory stream
MS := TMemoryStream.Create;
try
ImageBitmap:= TBitmap.Create;
try
while not ItemsDts.Eof do
begin
if not ItemsDtsPicture.IsNull then
begin
MS.Size := 0;
ItemsDtsPicture.SaveToStream(MS);
MS.Position := 0;
ImageBitmap.LoadFromStream(MS);
// Stretch the image
StretchedBMP.Canvas.StretchDraw(Rect(0, 0, StretchedBmp.Width-1, StretchedBmp.Height-1), ImageBitmap);
ImageList.Add(StretchedBmp, nil);
end;
ItemsDts.Next;
end;
finally MS.Free;
end;
finally StretchedBMP.Free;
end;
finally
ImageBitmap.Free;
end;
PS: I edited your code in the browser's window. I can't guarantee it compiles, but if it doesn't, it should be easy to fix.