I'm trying to convert a bunch of images with could have pixel formats of anything (4bit, 8bit, 16bit, 24bit etc) to an image that is 1bit.
I have the following code which will convert 24bit to 1bit, but this doesn't handle any other pixel formats.
procedure TFormMain.ButtonConvertClick(Sender: TObject);
var
Bitmap: TBitmap;
NewBitmap: TBitmap;
x,y: Integer;
ScanLine: pRGBTriple;
Colour: Integer;
FilePath: String;
FileName: String;
begin
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(EditFileName.Text);
NewBitmap := TBitmap.Create;
try
NewBitmap.PixelFormat := pf1bit;
NewBitmap.Height := Bitmap.Height;
NewBitmap.Width := Bitmap.Width;
for y := 0 to Bitmap.Height -1 do
begin
ScanLine := Bitmap.ScanLine[y];
for x := 0 to Bitmap.Width -1 do
begin
Colour := (ScanLine.rgbtBlue + ScanLine.rgbtGreen + ScanLine.rgbtRed) div 3;
if (Colour >= 128)
then Colour := clWhite
else Colour := clBlack;
NewBitmap.Canvas.Pixels[x, y] := Colour;
Inc(ScanLine);
end;
end;
FilePath := ExtractFilePath(EditFileName.Text);
FileName := TPath.GetFileNameWithoutExtension(EditFileName.Text);
NewBitmap.SaveToFile(TPath.Combine(FilePath, FileName + '-copy.bmp'));
finally
FreeAndNil(NewBitmap);
end;
finally
FreeAndNil(Bitmap);
end;
end;
I could handle each case individually, but there seems like there should be a function that does this. I have looked into the TGPBitmap.Clone function class, but I could only get it to produce blank(white) images and was unable to find any examples of its use.
The simplest way - draw any bitmap on 24bit one and use existing code.
The slowest way - get color of every pixel through Pixels[] property
Otherwise you have to treat every kind of bitmap individually. Note that 1,4 and 8-bit bitmaps contain indexes of palette, so you need to get proper color from bitmap palette, and 15 and 16-bit bitmaps pixels have structure xRRRRRGGGGGBBBBB and RRRRRGGGGGGBBBBB, so you need to extract 5 and 6-bit color parts and calculate overall pixel luminance.
Related
Below is my sample code:
var lBitmap: TBitmap;
begin
lBitmap := TBitmap.Create;
lBitmap.PixelFormat := TPixelFormat.pf32bit;
lBitmap.Transparent := TRUE; // !
lBitmap.LoadFromFile( 'd:\temp\bmp32b_300dpi_transparent_400x250.bmp' );
// Bitmap RGB+Alpha created with GIMP
// modifications on pixels
Canvas.Draw(100, 0, lBitmap);
// Up to this point it is correct, the drawing is painted with transparency
lBitmap.SaveToFile( 'd:\tmp\after.bmp' ); // after this -> I have lost transparency
lBitmap.Free;
end;
How to use correctly TBitmap object to save a file with transparency?
It seems to me like TBitmap doesn't support saving bitmaps with alpha channels. And maybe we shouldn't blame the VCL for this, because BMPs with alpha transparency are uncommon. Many applications don't support transparent BMPs.
This being said, I "reverse-engineered" a BMP with alpha channel created in GIMP and wrote the following Delphi routine to produce the very same bitmap:
procedure SaveTransparentBitmap(ABitmap: TBitmap; const AFileName: string);
var
FS: TFileStream;
BFH: TBitmapFileHeader;
BIH: TBitmapV5Header;
y: Integer;
sl: PUInt64;
begin
// ABitmap MUST have the GIMP BGRA format.
FS := TFileStream.Create(AFileName, fmOpenWrite);
try
// Bitmap file header
FillChar(BFH, SizeOf(BFH), 0);
BFH.bfType := $4D42; // BM
BFH.bfSize := 4 * ABitmap.Width * ABitmap.Height + SizeOf(BFH) + SizeOf(BIH);
BFH.bfOffBits := SizeOf(BFH) + SizeOf(BIH);
FS.Write(BFH, SizeOf(BFH));
// Bitmap info header
FillChar(BIH, SizeOf(BIH), 0);
BIH.bV5Size := SizeOf(BIH);
BIH.bV5Width := ABitmap.Width;
BIH.bV5Height := ABitmap.Height;
BIH.bV5Planes := 1;
BIH.bV5BitCount := 32;
BIH.bV5Compression := BI_BITFIELDS;
BIH.bV5SizeImage := 4 * ABitmap.Width * ABitmap.Height;
BIH.bV5XPelsPerMeter := 11811;
BIH.bV5YPelsPerMeter := 11811;
BIH.bV5ClrUsed := 0;
BIH.bV5ClrImportant := 0;
BIH.bV5RedMask := $00FF0000;
BIH.bV5GreenMask := $0000FF00;
BIH.bV5BlueMask := $000000FF;
BIH.bV5AlphaMask := $FF000000;
BIH.bV5CSType := $73524742; // BGRs
BIH.bV5Intent := LCS_GM_GRAPHICS;
FS.Write(BIH, SizeOf(BIH));
// Pixels
for y := ABitmap.Height - 1 downto 0 do
begin
sl := ABitmap.ScanLine[y];
FS.Write(sl^, 4 * ABitmap.Width);
end;
finally
FS.Free;
end;
end;
This write a BITMAPFILEHEADER followed by a BITMAPV5HEADER and the pixel data in BGRA format.
I omit all kinds of error checking. For instance, I don't verify that ABitmap actually has the required format.
Test:
procedure TForm1.FormCreate(Sender: TObject);
var
bm: TBitmap;
begin
bm := TBitmap.Create;
try
bm.LoadFromFile('C:\Users\Andreas Rejbrand\Desktop\Test.bmp');
SaveTransparentBitmap(bm, 'C:\Users\Andreas Rejbrand\Desktop\Test2.bmp');
finally
bm.Free;
end;
end;
After this, Test.bmp and Test2.bmp are binary equal.
Saving 32-bit bitmaps with alpha channels needs a workaround as #Andreas Rejbrand has pointed out. There also seems to be some more confusion about the BMP file format, what the TBitmap.Transparent property does, and how you draw bitmaps transparently with the VCL.
32-bit bitmaps are the only bitmaps that carry information about transparency in the files. They have that information in the alpha channel and nowhere else. In the alpha channel, every pixel has its own 0-255 alpha value in the RGBA structure. This is often referred to as partial transparency.
When you draw/display 32-bit bitmaps, you have to pay attention to the TBitmap.AlphaFormat property. It defaults to afIgnore, which means that the bitmap is drawn without transparency. Use afPremultiplied or afDefined to draw with transparency. The latter is probably what you want.
The TBitmap.Transparent property is specific to the VCL TBitmap, and there is nothing in the BMP file format that corresponds to it. It's just a simple way to display bitmaps transparently, where a color defines which pixels should be fully transparent. The application must be familiar with the bitmaps to be able to use this method. It's also important to be aware of how the TBitmap.TransparentMode property works. It defaults to tmAuto, which sets the color of the bottom-leftmost pixel of the bitmap as TBitmap.TransparentColor. When TransparentMode is set to tmFixed, the TBitmap.TransparentColor you have specified is used. This method can also be used on 32-bit bitmaps.
Note that when you draw with the standard VCL TCanvas drawing routines on a 32-bit bitmap with transparency in the alpha channel, the transparency will be lost where you have drawn.
It seems that in your sample code, you have ignored AlphaFormat and TransparentMode. You should also decide if you want to use the transparency in the alpha channel or the TBitmap.Transparent method. But we have no bitmap in order to check if that is the real problem.
I want to copy pixels from BMP1 to BMP2 but the copied image is gabbled. Why?
Note: The input image is pf8bit;
TYPE
TPixArray = array[0..4095] of Byte;
PPixArray = ^TPixArray;
procedure Tfrm1.CopyImage;
VAR
BMP1, BMP2: TBitmap;
y, x: Integer;
LineI, LineO: PPixArray;
begin
BMP1:= TBitmap.Create;
BMP2:= TBitmap.Create;
TRY
BMP1.LoadFromFile('test.bmp');
BMP2.SetSize(BMP1.Width, BMP1.Height);
BMP2.PixelFormat:= BMP1.PixelFormat;
for y:= 0 to BMP1.Height -1 DO
begin
LineI := BMP1.ScanLine[y];
LineO := BMP2.ScanLine[y];
for x := 0 to BMP1.Width -1 DO
LineO[x]:= LineI[x];
end;
//BMP2.SaveToFile('out.bmp');
imgOut.Picture.Assign(BMP2); //TImage
FINALLY
FreeAndNil(BMP2);
FreeAndNil(BMP1);
END;
end;
For the saved image, a graphic editor says "Pixel depth/colors: indexed, 256 color palette".
It might be worth pointing out that an 8-bit bitmap isn't necessarily greyscale.
Instead, it is a bitmap with a "colour table" consisting of up to 256 entries, and each pixel refers to an entry in this table. So if a pixel's value is 185, this means that it should use the colour at location 185 in the bitmap's "colour table". Hence, an 8-bit bitmap works entirely different compared to a 16-, 24- or 32-bit bitmap, which does not have a colour table, but instead has actual RGB(A) values at each pixel.
The problem in your case is likely that the target pixmap doesn't have the same colour table as the source bitmap.
I have actually never worked with 8-bit bitmaps and palettes before, but I think it is this simple:
var
s, t: TBitmap;
y: Integer;
sp, tp: PByte;
x: Integer;
begin
s := TBitmap.Create;
try
s.LoadFromFile('C:\Users\Andreas Rejbrand\Desktop\bitmap.bmp');
Assert(s.PixelFormat = pf8bit);
t := TBitmap.Create;
try
t.PixelFormat := pf8bit;
t.SetSize(s.Width, s.Height);
t.Palette := s.Palette; // <-- Let the new image have the same colour table
for y := 0 to s.Height - 1 do
begin
sp := s.ScanLine[y];
tp := t.ScanLine[y];
for x := 0 to s.Width - 1 do
tp[x] := sp[x];
end;
t.SaveToFile('C:\Users\Andreas Rejbrand\Desktop\bitmap2.bmp');
finally
t.Free;
end;
finally
s.Free;
end;
How can I set TImage size as double value? Example Image1.width := 50.1; or what component accept it, because TImage only accept integer values.
I'm working with download files, and one image should be the number of elements to download, so Image1.width max value is 340, i need to divide this value by the amount of files who will be downloaded, and increase this value on image1.width when every download be finished, but TImage only accept Integer value.
I already did it using "Round" but it is not what I need.
As answered, you cannot set the image's size to any floating point value.
However, using coordinate spaces and transformations functions, you can set an arbitrary transformation between a logical coordinate system and the viewing device. This can be used to increase the logical extent of the image's canvas size with each download and yet keep the image on the screen with an entirely different size.
The below example demonstrates the concept by drawing 4 rows and 4 columns of a 256x256 image on a 105x105 bitmap canvas of a TPicture of a TImage. Basically it achieves to draw a single 256x256 image on a 26.25x26.25 px. surface.
uses
pngimage;
procedure TForm1.Button1Click(Sender: TObject);
const
Col = 4;
Row = 4;
var
Png: TPngImage;
ImgCanvas: TCanvas;
ExtX, ExtY: Integer;
MapMode: Integer;
Size: TSize;
i, j: Integer;
begin
Png := TPngImage.Create;
try
Png.LoadFromFile('...\Attention.png');
Png.Draw(Canvas, Rect(0, 0, Png.Width, Png.Height)); // original picture
Image1.Picture.Bitmap.Canvas.Brush.Color := Color;
Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
ImgCanvas := Image1.Picture.Bitmap.Canvas;
SetStretchBltMode(ImgCanvas.Handle, HALFTONE);
MapMode := SetMapMode(ImgCanvas.Handle, MM_ISOTROPIC);
if MapMode <> 0 then
try
ExtX := Png.Width * Col;
ExtY := Png.Height * Row;
if not GetWindowExtEx(ImgCanvas.Handle, Size) then
RaiseLastOSError;
if not SetWindowExtEx(ImgCanvas.Handle, Size.cx * ExtX div Image1.Width,
Size.cy * ExtY div Image1.Height, nil) then
RaiseLastOSError;
if not SetViewportExtEx(ImgCanvas.Handle, Size.cx, Size.cy, nil) then
RaiseLastOSError;
i := 0;
j := 0;
while j < ExtY do begin
while i < ExtX do begin
Png.Draw(ImgCanvas, Rect(i, j, i + Png.Width, j + Png.Height));
Inc(i, Png.Width);
end;
i := 0;
Inc(j, Png.Height);
end;
finally
SetMapMode(ImgCanvas.Handle, MapMode);
end
else
RaiseLastOSError;
finally
Png.Free;
end;
end;
Probably worth noting that GDI may not be the best graphics system when scaling is involved. For quick reference, here's what the above yields:
Assuming you're using the VCL framework, all controls across Delphi are Integer based. You simply cannot assign a float value, not without first converting it to an integer.
The Firemonkey framework on the other hand is widely based on float values.
how can I create an image and how can I colored it pixel by pixel using hexadecimal code of colors?
For ex. I wanna create a 100x100 pixel image and I wanto to 1x1 area's color is '$002125',2x2 area's color is '$125487'.... How can I do it?
Thank you for your answers..
Made a simple sample for you. Using Canvas.Pixels not Scanline. Scanline is faster though but for start I think it suits just fine. The colors are randomly generated, so you just need to replace this part of the code.
procedure TForm1.GenerateImageWithRandomColors;
var
Bitmap: TBitmap;
I, J: Integer;
ColorHEX: string;
begin
Bitmap := TBitmap.Create;
Randomize;
try
Bitmap.PixelFormat := pf24bit;
Bitmap.Width := 100;
Bitmap.Height := 100;
for I := 0 to Pred(Bitmap.Width) do
begin
for J := 0 to Pred(Bitmap.Height) do
begin
Bitmap.Canvas.Pixels[I, J] := RGB(Random(256),
Random(256),
Random(256));
// get the HEX value of color and do something with it
ColorHEX := ColorToHex(Bitmap.Canvas.Pixels[I, J]);
end;
end;
Bitmap.SaveToFile('test.bmp');
finally
Bitmap.Free;
end;
end;
function TForm1.ColorToHex(Color : TColor): string;
begin
Result :=
IntToHex(GetRValue(Color), 2) +
IntToHex(GetGValue(Color), 2) +
IntToHex(GetBValue(Color), 2);
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.