How can convert emf to bmp with delphi 2010?
If you want to draw the EMF with Anti-Aliaising, you can use our freeware SynGdiPlus library:
Gdip := TGDIPlusFull.Create;
MF := TMetaFile.Create;
MF.LoadFromFile(Files[Tag]);
Bmp := Gdip.DrawAntiAliased(MF,100,100); // 100% zoom in both axis
img1.Picture.Assign(Bmp);
The drawing is done using GDI+, so the rendering will be much better than the direct Canvas.Draw direct method.
You could try to use basis anti-aliaising by stretching the bitmap to a smaller size, but in this case, the font rendering will be alterated. Our native GDI+ drawing produces better rendering quality.
See http://synopse.info/forum/viewtopic.php?id=10
Use this code
procedure ConvertEMF2BMP(EMFFileName, BMPFileName: String) ;
var
MetaFile : TMetafile;
Bitmap : TBitmap;
begin
Metafile := TMetaFile.Create;
Bitmap := TBitmap.Create;
try
MetaFile.LoadFromFile(EMFFileName) ;
with Bitmap do
begin
Height := Metafile.Height;
Width := Metafile.Width;
Canvas.Draw(0, 0, MetaFile) ;
SaveToFile(BMPFileName) ;
end;
finally
Bitmap.Free;
MetaFile.Free;
end;
end;
Try something like:
var
bmp: TBitmap;
wmf: TMetafile;
bmp.SetSize(wmf.Width, wmf.Height);
bmp.Canvas.Draw(0, 0, wmf);
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 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);
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 need a fast way to create 24 bits bitmaps (and save to a file) in runtime,specifing the Width , Height and color
something like
procedure CreateBMP(Width,Height:Word;Color:TColor;AFile: string);
and call like this
CreateBMP(100,100,ClRed,'Red.bmp');
you can use the Canvas property of the TBitmap, setting the Brush to the color which you want to use, then call FillRect function to fill the Bitmap.
try something like this :
procedure CreateBitmapSolidColor(Width,Height:Word;Color:TColor;const FileName : TFileName);
var
bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.PixelFormat := pf24bit;
bmp.Width := Width;
bmp.Height := Height;
bmp.Canvas.Brush.Color := Color;
bmp.Canvas.FillRect(Rect(0, 0, Width, Height));
bmp.SaveToFile(FileName);
finally
bmp.Free;
end;
end;
You don't actually need to call FillRect. If you set the Brush.Color before setting the width and height the bitmap will use this color for all the pixels. I've never actually seen this behavior documented so it may change in future versions.