Hi mates i want to print a picture i generated i use the following code
Printer.BeginDoc;
Printer.Canvas.Draw(0,0,img1.Picture.Bitmap);
Printer.EndDoc;
It works but the image it prints is very small how can i print the actual size of the image as it appears on the screen ?
Thanks very much.
You can call Canvas.StretchDraw() instead. However, be prepared for the results to be less than impressive. Trying to scale a raster image in this way will lead to very blocky results. Vector images are what you need in order to be able to scale to printer resolutions.
var
Scale: Integer;
...
Scale := Min(
Printer.PageWidth div Bitmap.Width,
Printer.PageHeight div Bitmap.Height
);
Printer.Canvas.StretchDraw(
Rect(0, 0, Bitmap.Width*Scale, Bitmap.Height*Scale),
Bitmap
);
The scaling I chose here will preserve the aspect ratio and make the image as large as possible when printed.
You should achieve better results if you resize the image to an intermediate bitmap (with a size suitable for the printer resolution) using one of the resamplers in JCL or Graphics32 and then you print the resized bitmap.
The following routine will try to get the same size in printer as in the screen:
uses
JclGraphics;
procedure PrintGraphic(source: TGraphic);
var
dest: TBitmap;
destWidth, destHeight,
printerPixelsPerInch_X, printerPixelsPerInch_Y,
printerLeftMargin, printerTopMargin: integer;
begin
printerPixelsPerInch_X := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
printerPixelsPerInch_Y := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
printerLeftMargin := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
printerTopMargin := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
dest := TBitmap.Create;
try
destWidth := source.Width * printerPixelsPerInch_X div Screen.PixelsPerInch;
destHeight := source.Height * printerPixelsPerInch_Y div Screen.PixelsPerInch;
Stretch(destWidth, destHeight, rfLanczos3, 0, source, dest);
Printer.BeginDoc;
try
Printer.Canvas.Draw(printerLeftMargin, printerTopMargin, dest);
Printer.EndDoc;
except
Printer.Abort;
raise;
end;
finally
dest.Free;
end;
end;
procedure TFormMain.Button1Click(Sender: TObject);
begin
if not PrinterSetupDialog.Execute then
exit;
PrintGraphic(Image1.Picture.Graphic);
end;
IIRC (I don't have Delphi in front of me to check right now), TPrinter has a PixelsPerInch or similar property that has to be set so printing is at the correct resolution. The default value does not match the screen, which is why the image gets printed so small. Most newbies to using TPrinterdon't know to set the property.
Related
Gretings to all!
How to print pictures in Delphi on TPrinter, in real sizes of pictures?
From canvas of TImage I have good results, but if I paints on TPrinter canvas, I have BAD result, puctures is too small than real size of bitmap.
Why that happens What I'm need to do for fix bug?
UPDATE
Yes, I seen question from the hint in the 1st post.
I can't use JCL/JVCL code in my project, but I got idea from it.
I create temporary TImage, and calculate dimensions of it in accordance with the factor of printer's DPI:
var
i, iRow, iCol, // Counter
iBorderSize, // Ident from left/top borders
iImgDistance, // Ident between images in grid
iRows, // Rows Count
iColumns, // Colun count
iLeft, iTop: Integer; // For calc
bmp: TBitmap;
bStop, bRowDone, bColDone: Boolean;
Img1: TImage;
scale: Double;
function CalcY: Integer;
begin
if (iRow = 1) then
Result := iBorderSize
else
Result := iBorderSize + (iImgDistance * (iRow - 1)) +
(bmp.Height * (iRow - 1));
end;
function CalcX: Integer;
begin
if (iCol = 1) then
Result := iBorderSize
else
Result := iBorderSize + (iImgDistance * (iCol - 1)) +
(bmp.Width * (iCol - 1));
end;
begin
iBorderSize := StrToInt(BorderSizeEdit.Text);
iImgDistance := StrToInt(ImgsDistanceEdit.Text);
iRows := StrToInt(RowsCountEdit.Text);
iColumns := StrToInt(ColCountEdit.Text);
iRow := 1;
iCol := 1;
iLeft := iBorderSize;
iTop := iBorderSize;
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) /
Screen.PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) /
Screen.PixelsPerInch;
bmp := TBitmap.Create;
Img1 := TImage.Create(nil);
Img1.Height := Trunc(Printer.PageHeight / scale); //Calc canvas size
Img1.Width := Trunc(Printer.PageWidth / scale); //Calc canvas size
Img1.Canvas.Brush.Color := clWhite;
Img1.Canvas.FillRect(Rect(0, 0, Img1.Width, Img1.Height));
try
bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');
for i := 1 to 18 do
begin
if (iRow <= iRows) then
begin
iTop := CalcY;
iLeft := CalcX;
Img1.Canvas.Draw(iLeft, iTop, bmp);
if not((iRow = iRows) and (iCol = iColumns)) then
begin
if (iCol = iColumns) then
begin
Inc(iRow);
iCol := 1;
end
else
Inc(iCol);
end
else
begin
PrintImage(Img1, 100);
iRow := 1;
iCol := 1;
Img1.Canvas.Brush.Color := clWhite;
Img1.Canvas.FillRect(Rect(0, 0, Img1.Width, Img1.Height));
end;
end;
end;
finally
FreeAndNil(bmp);
FreeAndNil(Img1);
end;
end;
And draw it on TPrinter.Canvas.
You can see results below:
Results is good, but not perfect.
As you can see, in the last column, all images are drawn not to the end, some part misses off the paper and not drawn.
I think it's happens because I use the Trunc to get integer part of double when I'm calculate dimensions of TImage.Canvas in accordance with the factor of printer's DPI.
By experiments I know value 0.20. 0.20 is a part of last column images, in pixels, that not drawn. If I change code, that gets scale factor by this:
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) /
Screen.PixelsPerInch - 0.20
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) /
Screen.PixelsPerInch - 0.20;
I have that, what I need:
I think the value 0.20 isn't a constant and it will change on every PC.
How to calculate this value? What need to solve this problem?
The basic problem here is one of scaling. More or less, figure out how much to expand the resolution of the image and then stretchdraw it to the printer canvas. Something like this gets the image stretched out to the dimension of the printer canvas.
procedure TForm1.Button2Click(Sender: TObject);
var
MyRect: TRect;
scale: Double;
begin
if PrintDialog1.Execute then
begin
Printer.BeginDoc;
scale := Printer.PageWidth / Bitmap1.Width;
ShowMessage(FloatToStr(scale));
{ horizontal pixels, vertical pixels, bit depth 600 x 600 x 24}
MyRect.Left := 0;
MyRect.Top := 0;
MyRect.Right := trunc(Bitmap1.Width * scale);
MyRect.Bottom := trunc(Bitmap1.Height * scale);
Printer.Canvas.StretchDraw(MyRect, Bitmap1);
Printer.EndDoc;
end;
Of course, you have to check "Right" and "Bottom" to make sure they don't exceed your PageWidth and PageHeight depending on the type of scaling you use (6.25 or 600/96 seems fine for simply making an image the same relative size as the screen, assuming those numbers match your printer and screen), assuming you want to keep the image to one page and not mosaic pieces of it onto multiple pages.
I don't know if this works entirely since I don't have a varied number of devices (i.e. different DPIs) to test both orientations on, but this seems to be what you want to get both DPI numbers dynamically.
if Printer.Orientation = poPortrait then
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) / PixelsPerInch
else
scale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) / pixelsperinch;
Then of course, you multiply like above.
The issue you're running into is that there really isn't a "real size" of an image, it's all relative. The printer often has a lot higher resolution then your monitor and that's why pictures look small.
Your monitor has often a resolution of 96 dpi and normal printer has a resolution of 600 dpi which means your image prints in its real size it just looks small because a printer can put a lot more dots in the same space then a monitor can.
Delphi Basics link was also helpful : http://www.delphibasics.co.uk/RTL.asp?Name=printer&ExpandCode1=Yes
on form : drag n drop TPrintDialog from your Tool Palette
and manually add this to the uses clause under [Implementation]
uses printers; // Unit containing the printer command
With that and this post I was able to print directly to any printer at the size I wanted for images or text. There is no need to call the bitmap or assign the TPrinter once you have added the unit above. Just draw directly to the canvas in your PC printer queue.
procedure TForm1.cmdPrintCircleClick(Sender: TObject);
var
xx, yy, mySize : integer;
//printer1 : TPrinter;
begin
// create image directly on Printer Canvas and print it
//Ellipse( X-(Width div 2), Y-(Height div 2), X+(Width div 2), Y+(Height div 2));
if PrintDialog1.Execute then
try
with Printer do
begin
if Printer.Orientation = poPortrait then
begin
// represents 1/2 US-inch relative to Portrait page size 8.5 x 11
mySize := Trunc(PageWidth / 8.5 / 2);
end
else
begin
// represents 1/2 US-inch relative to Landscape page size 11 x 8.5
mySize := Trunc(PageHeight / 8.5 / 2);
end;
xx := Trunc(PageWidth / 2);
yy := Trunc(PageHeight / 2);
// Start printing
BeginDoc;
// Write out the ellipse // create one-inch black circle
Canvas.Brush.Color := clBlack;
Canvas.Ellipse(xx - mySize, yy - mySize, xx + mySize, yy + mySize);
// Finish printing
EndDoc;
end;
finally
end;
end;
My application is developed in Delphi 6. This is a resource intesive application due to background processing and large volume of data (It consumes around 60MB - 120MB of physical memory). One of the functionality of this application is to create barcode images after doing certain procesing.
If user keeps on generating the Barcodes, then at least One out of Ten Barcode has missing lines in it.
We have following steps in generating the output:
Create a Barcode image (TImage) in the memory. The height of the image is 10 pixels. We use pf24bit pixel format.
Resizing the image in the memory according to printer's canvas and passing it to the printer's canvas.
The code for Step # 2 is as following :
procedure PrintBitmap(ARect:TRect; Bitmap:TBitmap);
var
Info: PBitmapInfo;
InfoSize: dword{Integer};
Image: Pointer;
ImageSize: dword{ integer};
iReturn : integer ;
iWidth,iHeight :integer;
begin
try
with Bitmap do
begin
iReturn := 1;
GetDIBSizes( Handle, InfoSize, ImageSize );
GetMem( Info, InfoSize );
try
getMem( Image, ImageSize );
try
GetDIB(Handle, Palette, Info^, Image^);
try
with Info^.bmiHeader do
begin
SetStretchBltMode(Printer.Canvas.handle,HALFTONE);
iReturn := **StretchDIBits**(Printer.Canvas.Handle, ARect.Left, ARect.Top,
ARect.Right - ARect.Left, ARect.Bottom - ARect.Top,
0, 0, biWidth, biHeight, Image, Info^, DIB_RGB_COLORS, SRCCOPY);
end;
except on E:Exception do
begin
gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in StretchDIBits with message '+e.Message);
end;
end
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end
except on E:Exception do
begin
gobjLog.pWritetoLog(0,'RptWrks2','PrintBitmap','Exception in PrintBitMap with message '+e.Message);
end;
end;
We checked that the issue lies in the Step # 2 , as the barcode image is generated without any issue. (We commented out Step # 2 and took the output as BMP files to confirm this).
Also, we tried following workarounds :
We used TExcellentImagePrinter component to perform the resizing operation. But, issue was not resolved.
We included SETPROCESSWORKINGSETSIZE WinAPI call to reduce/refresh the current memry used by the application.
We included Sleep(3000) in the code so that the Windows is able to allocate the memory for the image. Including Sleep however reduced the frequency of occurrence of this error.
Can you please provide any suggestions?
I use this function for printing barcodes with great success. It assumes that the bitmap is 100% scaled barcode (each x-pixel is a barcode stripe), the height does not matter, it may be only 1px.
The clue is to print the barcode with fillrect and not as a bitmap:
The function just "reads" the barcode and draws it with fillrect to some canvas. If the resulting scale (xFactor = aToRect width to barcode width) is either an integer number or a big enough real number (for printers no problem) the printed barcode can be read without any problems. It also works great with PDF Printers.
You just have to generate a 100% scaled barcode to bitmap (as you already do; height may be 1px; color of the barcode must be clBlack) and pass it in the aFromBMP parameter. aToCanvas will then be your printer canvas. aToRect is the destination rect in printer canvas. aColor is the color of the destination barcode (may be everything).
procedure PrintBarCodeFromBitmap(const aFromBMP: TBitmap;
const aToCanvas: TCanvas; const aToRect: TRect;
const aColor: TColor = clBlack);
var I, xStartRect: Integer;
xFactor: Double;
xColor: TColor;
xLastBrush: TBrush;
begin
xLastBrush := TBrush.Create;
try
xLastBrush.Assign(aToCanvas.Brush);
aToCanvas.Brush.Color := aColor;
aToCanvas.Brush.Style := bsSolid;
xFactor := (aToRect.Right-aToRect.Left)/aFromBMP.Width;
xStartRect := -1;
for I := 0 to aFromBMP.Width do begin
if I < aFromBMP.Width then
xColor := aFromBMP.Canvas.Pixels[I, 0]
else
xColor := clWhite;
if (xStartRect < 0) and (xColor = clBlack) then begin
xStartRect := I;
end else if (xStartRect >= 0) and (xColor <> clBlack) then begin
aToCanvas.FillRect(
Rect(
Round(aToRect.Left+xStartRect*xFactor),
aToRect.Top,
Round(aToRect.Left+I*xFactor),
aToRect.Bottom));
xStartRect := -1;
end;
end;
finally
aToCanvas.Brush.Assign(xLastBrush);
xLastBrush.Free;
end;
end;
Finally I was able to resolve the issue using TExcellentImagePrinter.
I replaced GETDIB with LoadDIBFromTBitmap function and StretchDIBits with PrintDIBitmapXY in the above code snippet (my post).
Thanks to Joe for providing proper guidelines.
Having some trouble with printing JPEG images via Delphi TCanvas.
Anywhere between 30-50% of the time the JPEG will print out as a black
square rather than as it should. Have tried changing many settings to see
if there was a particular condition under which it would fail to print but
as of the time of writing nothing has worked and the condition still exists - I am not able to tell when the printout may have a black JPEG or when it will print correctly.
Here is the code I am using to print the JPEG to the Canvas.
Screen.Cursor := crHourGlass;
try
// initialize image
//>>imgImage := TImage.Create(Self);
imgImage := TImage.Create(Application);
// load image from file
imgImage.Picture.LoadFromFile(sFileNameAndPath);
// set width and height to that of loaded image
////imgImage.Autosize := true;
////Printer.Orientation := poPortrait;
// Header
Printer.Canvas.Font.Height := MulDiv(GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY), 12, 72);
Printer.Canvas.Font.Name := 'Courier New';
// Determine height and width of 1 printer-character
iDeltaW := Printer.Canvas.TextWidth('X');
iDeltaH := Printer.Canvas.TextHeight('X');
// ------------------------------
// Method #1 - columns and lines
// ------------------------------
// what column to printing from
iFromLeftMargin := iLeft * iDeltaW;
// what line to print from
iFromTopOfPage := iTop * iDeltaH;
// ------------------------------
// Method #2 - pixels
// ------------------------------
iPPW := Printer.PageWidth;
iPPH := Printer.PageHeight;
iIPW := imgImage.Picture.Width;
ePXW := iPPW / iInvImageWidth;
ePXH := iPPH / iInvImageHeight;
//~//iFromLeftMargin := Ceil(iLeft * pxW);
//~//iFromTopOfPage := Ceil(iTop * pxH);
iFromLeftMargin := Ceil(iLeft * ePXW);
iFromTopOfPage := Ceil(iTop * ePXH);
// Set printed bitmap width
iPrintedImageWidth := MulDiv(iPPW, iIPW, iInvImageWidth);
// Set printed bitmap height to maintain aspect ratio
iPrintedImageHeight := imgImage.Picture.Height * iPrintedImageWidth DIV
imgImage.Picture.Width; // maintain aspect ratio of bitmap
Bitmap := TBitmap.Create;
try
Bitmap.Width := imgImage.Picture.Width;
Bitmap.Height := imgImage.Picture.Height;
Bitmap.PixelFormat := pf24bit;
Bitmap.IgnorePalette := False;
// Convert JPEG (GIF, or whatever) to BMP
Bitmap.Canvas.Draw(0, 0, imgImage.Picture.Graphic);
// Print Image
PrintBitmap(Printer.Canvas,
Rect(iFromLeftMargin, iFromTopOfPage,
iFromLeftMargin + iPrintedImageWidth,
iFromTopOfPage + iPrintedImageHeight),
Bitmap);
finally
// free bitmap memory
Bitmap.Free;
end;
// free image memory
imgImage.Free;
finally
Screen.Cursor := crDefault;
end;
If anyone had any ideas it would be much appreciated!
Regards,
James
EDIT: code for the PrintBitmap method below. I have taken the advice of saving the bitmap to disk to view it as it is being generated and the it is never saved as a black square even when the printed output is a black square. I hope this indicated the problem is in the PrintBitmap code below.
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: pBitmapInfo;
BitmapImage: POINTER;
HeaderSize: DWORD;
ImageSize: DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY);
finally
FreeMem(BitmapHeader);
FreeMem(BitmapImage);
end;
end; {PrintBitmap}
Unfortunately this code was written by someone who no longer works at my company and I am only trying to fix an existing issue.
It's hard to tell with the snippet you posted. You should post some self sufficient working code (compilable and runnable).
There is no local var declaration for instance, no Begindoc/EndDoc.
Now, after adding the local declarations, there is a bunch of compiler warnings for Uninitialized Variables like iTop or iLeft. If those are left with random garbage, it could be that you don't draw where you think you do.
You also assume that you always have a pf24bit format which is not guaranteed at all. As you don't specify if the same JPG can print OK or fail randomly, or if it is with different JPGs that you have problems, format conversion problems cannot be excluded.
I would also suggest that you install one of the free available Image Debug Visualizers, place a break point before PrintBitmap and see if the local Bitmap is correct before printing.
Then let us see what is in the PrintBitmap procedure... Did you try to directly draw on the Printer Canvas?
Update:
The PrintBitmap code seems legit except that it does not check for any return code:
if not GetDIB(...) then
raise [...];
if GDI_ERROR = StretchDIBits(...) then
RaiseLastOSError;
The problem might come from the Printer/Driver.
Did you try with another printer or with another driver?
Also, make sure your printer is ready...
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.