I'm trying to do the following:
bmp := TBitmap.Create;
bmp.Width := FWidth;
bmp.Height := FHeight;
for y := 0 to FHeight - 1 do
begin
sl := bmp.ScanLine[y];
for x := 0 to FWidth - 1 do
begin
//draw to the scanline, one pixel at a time
end;
end;
//display the image
bmp.Free;
Unfortunately, what I end up with is an image that's completely white, except for the bottom line, which is colored appropriately. A bit of debugging shows that each time I access the ScanLine property, it's calling TBitmap.FreeImage, and going into the if (FHandle <> 0) and (FHandle <> FDIBHandle) then block, which resets the whole image, so only the changes to the last line actually take.
In every demo I've seen so far using TBitmap.ScanLine, they start out by loading an image. (Apparently this sets up various handles correctly so that this doesn't end up happening?) But I'm not trying to load an image and work on it; I'm trying to capture image data from a camera.
How can I set up the bitmap so that I can draw to the scanlines without having to load an image first?
You should set the PixelFormat explicitly before starting to draw. For instance,
procedure TForm1.FormPaint(Sender: TObject);
var
bm: TBitmap;
y: Integer;
sl: PRGBQuad;
x: Integer;
begin
bm := TBitmap.Create;
try
bm.SetSize(1024, 1024);
bm.PixelFormat := pf32bit;
for y := 0 to bm.Height - 1 do
begin
sl := bm.ScanLine[y];
for x := 0 to bm.Width - 1 do
begin
sl.rgbBlue := 255 * x div bm.Width;
sl.rgbRed := 255 * y div bm.Height;
sl.rgbGreen := 255 * x div bm.Width;
inc(sl);
end;
end;
Canvas.Draw(0, 0, bm);
finally
bm.Free;
end;
end;
Related
I want to assign a given buffer with a bitmap in Mono8 format (Monochrome 8 Bits) to a bitmap. I then assign the resulting bitmap to a TImage component to display it. The pictures are screenshots of the resulting display.
The following code works but seems a bit wasteful:
procedure CopyToBitmapMono824(_Buffer: PByte; _Bmp: TBitmap);
var
y: Integer;
x: Integer;
ScanLine: PdzRgbTripleArray;
begin
for y := 0 to _Bmp.Height - 1 do begin
ScanLine := _Bmp.ScanLine[y];
for x := 0 to _Bmp.Width - 1 do begin
// monochrome: all 3 colors set to the same value
ScanLine[x].Red := _Buffer^;
ScanLine[x].Green := _Buffer^;
ScanLine[x].Blue := _Buffer^;
Inc(_Buffer);
end;
end;
end;
// [...]
fBmp.PixelFormat := pf24Bit;
FBmp.Monochrome := False;
CopyToBitmap(Buffer, fBmp);
I would rather use a bitmap in pf8Bit format which I tried:
procedure CopyToBitmapMono8(_Buffer: PByte; _Bmp: TBitmap);
var
y: Integer;
x: Integer;
ScanLine: PByteArray;
begin
for y := 0 to _Bmp.Height - 1 do begin
ScanLine := _Bmp.ScanLine[y];
for x := 0 to _Bmp.Width - 1 do begin
ScanLine[x] := _Buffer^;
Inc(_Buffer);
end;
end;
end;
// [...]
FBmp.PixelFormat := pf8bit;
FBmp.Monochrome := False; // I also tried Monochrome := true
CopyToBitmapMono8(Buffer, FBmp)
If MonoChrome is true, the picture only has about 1/4 of the expected width, the rest is white.
If MonoChrome is false, the picture has the expected width, but the left 1/4 of it is monochrome, the rest contains false colors.
I'm obviously missing something, but what?
EDIT: The effect that the bitmap is only 1/4 of the expected size apparently was a side effect of converting it to a JPEG for saving prior to displaying it (code that I did not show above, mea culpa). So the problem was simply that I did not set a monochrome palette for the bitmap.
Monochrome has sense for pf1bit bitmaps.
Otherwise Monochrome := True changes bitmap format to DDB (pfDevice). Your screen is 32-bit, so call to Scanline caused DibNeeded call and transformation to 32bit, and using of function CopyToBitmapMono8 (intended for 8-bit) filled only 1/4 of screen.
For proper usage of 8-bit bitmaps you have to change standard weird palette (used in the right part of last image) to gray one.
procedure CopyToBitmapMono8(_Buffer: PByte; _Bmp: TBitmap);
var
y: Integer;
x: Integer;
ScanLine: PByteArray;
begin
for y := 0 to _Bmp.Height - 1 do begin
ScanLine := _Bmp.ScanLine[y];
for x := 0 to _Bmp.Width - 1 do begin
ScanLine[x] := _Buffer^;
Inc(_Buffer);
end;
end;
end;
var
FBmp: TBitmap;
Buffer: PbyteArray;
i: integer;
begin
GetMem(Buffer, 512 * 100);
for i := 0 to 512 * 100 - 1 do
Buffer[i] := (i and 511) div 2; // gray gradient
FBmp := Tbitmap.Create;
FBmp.Width := 512;
FBmp.Height := 100;
FBmp.PixelFormat := pf8bit;
CopyToBitmapMono8(PByte(Buffer), FBmp);
Canvas.Draw(0, 0, FBmp);
//now right approach
FBmp.Palette := MakeGrayPalette; // try to comment
CopyToBitmapMono8(PByte(Buffer), FBmp);
Canvas.Draw(0, 110, FBmp);
end;
function TForm1.MakeGrayPalette: HPalette;
var
i: integer;
lp: TMaxLogPalette;
begin
lp.palVersion := $300;
lp.palNumEntries := 256;
for i := 0 TO 255 do begin
lp.palPalEntry[i].peRed := i;
lp.palPalEntry[i].peGreen := i;
lp.palPalEntry[i].peBlue := i;
lp.palPalEntry[i].peFlags := PC_RESERVED;
end;
Result := CreatePalette(pLogPalette(#lp)^);
end;
And example at efg2 page
I have an image list containing several bitmaps which I would like to save together as one single bitmap, but I need it saving just like how a spritesheet or tilesheet is drawn in 2d and rpg games etc.
Typically the tilesheet is drawn with several images across (in a row), so for example if I wanted a maximum of 6 images per row, it will only draw 6, with further images been drawn underneath in a new row.
I can save it in one single row like so:
var
CurrentFrame: Integer;
StripWidth: Integer;
Strip: TBitmap;
Bmp: TBitmap;
I: Integer;
begin
if SaveDialog.Execute then
begin
StripWidth := ImageList1.Width * ImageList1.Count - ImageList1.Width;
CurrentFrame := - ImageList1.Width;
Strip := TBitmap.Create;
try
Strip.SetSize(StripWidth, ImageList1.Height);
Bmp := TBitmap.Create;
try
for I := 0 to ImageList1.Count - 1 do
begin
CurrentFrame := CurrentFrame + ImageList1.Width;
ImageList1.GetImage(I, Bmp);
Strip.Canvas.Draw(CurrentFrame, 0, Bmp);
end;
finally
Bmp.Free;
end;
Strip.SaveToFile(SaveDialog.FileName);
finally
Strip.Free;
end;
end;
end;
So imagine the result for the above is:
The result I want is something like:
So the above would have considered in the procedure/ function a parameter to allow only 3 images per row as an example.
How do I export all images from an imagelist into one single bitmap, allowing only x amount if images to be drawn horizontally before creating a new row?
Thanks.
EDIT
Thanks to David's answer, I put together these procedures:
procedure DrawImageOnSheet(Images: TImageList; Sheet: TBitmap;
ImageIndex, X, Y: Integer);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
try
Images.GetBitmap(ImageIndex, Bitmap);
Sheet.Canvas.Draw(X, Y, Bitmap);
finally
Bitmap.Free;
end;
end;
procedure SaveImageListAsSheet(Images: TImageList; FileName: string;
NumberOfColumns: Integer);
var
Sheet: TBitmap;
nImage: Integer;
nCol: Integer;
nRow: Integer;
nToDraw: Integer;
nRemaining: Integer;
ImageIndex: Integer;
X, Y: Integer;
I: Integer;
begin
Sheet := TBitmap.Create;
try
nImage := Images.Count;
nCol := NumberOfColumns;
nRow := (nImage + nCol - 1) div nCol;
Sheet.Height := nRow * Images.Height;
Sheet.Width := nCol * Images.Width;
nRemaining := nImage;
ImageIndex := 0;
Y := 0;
while nRemaining > 0 do
begin
nToDraw := Math.Min(nRemaining, nCol);
X := 0;
for I := 0 to nToDraw - 1 do
begin
DrawImageOnSheet(Images, Sheet, ImageIndex, X, Y);
Inc(ImageIndex);
Inc(X, Images.Width);
end;
Inc(Y, Images.Height);
Dec(nRemaining, nToDraw);
end;
Sheet.SaveToFile(FileName);
finally
Sheet.Free;
end;
end;
According to clarification from the comments, you are struggling with the counting of the images, the organisation of the rows/columns and so on. So, let's assume you already have this function which draws image ImageIndex to the output bitmap at a position of X, Y.
procedure Draw(ImageIndex, X, Y: Integer);
Let's also assume that the images have dimensions given by ImageWidth and ImageHeight. Finally, there are nImage images and you want to have nCol images per column.
So, first of all, how many rows do you need?
nRow := (nImage + nCol - 1) div nCol;
Now you can set the size of the output bitmap. Its width is nCol * ImageWidth and its height is nRow * ImageHeight.
Now to draw the images.
nRemaining := nImage;
ImageIndex := 0;
Y := 0;
while nRemaining > 0 do
begin
nToDraw := Math.Min(nRemaining, nCol);
X := 0;
for i := 0 to nToDraw - 1 do
begin
Draw(ImageIndex, X, Y);
inc(ImageIndex);
inc(X, ImageWidth);
end;
inc(Y, ImageHeight);
dec(nRemaining, nToDraw);
end;
i want to draw a bitmap on a canvas with opacity where the bitmap has a transparent color.
i could create a bitmap with transparent color and draw it to a
canvas i could create a bitmap and draw it to a canvas with opacity
but i couldn't combine it. if i combine it the opacity is ignored.
here is the code i wrote:
procedure TForm1.FormPaint(Sender: TObject);
var b1,b2:TBitmap;
begin
// Example how it opacity works:
b1 := TBitmap.Create;
b1.SetSize(20,20);
b1.Canvas.Brush.Color := clBlue;
b1.Canvas.Rectangle(0,0,20,20);
Canvas.Draw(10,10,b1,$ff); // Works
Canvas.Draw(40,10,b1,$66); // Works
// I need it in combination with TransparentColor:
b2 := TBitmap.Create;
// next 3 lines are different from above
b2.Transparent := true;
b2.TransparentColor := clFuchsia;
b2.Canvas.Brush.Color := clFuchsia;
b2.SetSize(20,20);
b2.Canvas.Brush.Color := clBlue;
b2.Canvas.Ellipse(0,0,20,20);
Canvas.Draw(10,40,b2,$ff); // Works (full opacity)
Canvas.Draw(40,40,b2,$66); // Ignores the $66 Opacity
b1.Free;
b2.Free;
end;
produces:
how could i draw (f.e. a blue circle) with transparent background and just 40% opacity?
i would prefere a solution without direct winapi (like bitblt, ...) if possible.
i tried a few hacks like bitshifting a alpha channel to a TColor value but it didn't work.
here i what i tried:
procedure TForm1.FormPaint(Sender: TObject);
var b:TBitmap;
begin
b := TBitmap.Create;
b.PixelFormat := pf32bit;
b.AlphaFormat := afDefined;
b.Canvas.Brush.Color := 0 and ($ff shl 32); // Background Transperency
b.SetSize(20,20);
b.Canvas.Brush.Color := clBlue + (($ff-$66) shl 32);
b.Canvas.Ellipse(0,0,20,20);
Canvas.Draw(10,10,b);
b.Free;
end;
produces:
thanks in advance!
EDIT: my system: delphi xe 5 on windows 7 64bit (but using the 32bit compiler)
What happens can be seen in procedure TBitmap.DrawTransparent in the unit Graphics.
If the property of the image is set to transparent as show for b2 in your example the Bitmap will be drawn with
Graphics.TransparentStretchBlt which is using StretchBlt with differnt masks to draw the image and is not able to use the alpha channel.
A not tranparent Bitmap , your b1, will be draw with
AlphaBlend.
To reach your goal you might use another bitmap b2, set the Alphachannel to 0, paint b2 with opacity $66 on b3, set set the Alphachannel to 255 for every pixel which is clFuchsia in b2 and then paint this bitmap with the desired opacity
type
pRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;
TRefChanel=(rcBlue,rcRed,rcGreen);
procedure SetBitmapAlpha(ABitmap: TBitMap; Alpha: Byte);
var
pscanLine32: pRGBQuadArray;
nScanLineCount, nPixelCount : Integer;
begin
with ABitmap do
begin
PixelFormat := pf32Bit;
HandleType := bmDIB;
ignorepalette := true;
alphaformat := afDefined;
for nScanLineCount := 0 to Height - 1 do
begin
pscanLine32 := Scanline[nScanLineCount];
for nPixelCount := 0 to Width - 1 do
with pscanLine32[nPixelCount] do
begin
rgbReserved := Alpha;
end;
end;
end;
end;
procedure AdaptBitmapAlpha(ABitmap,TranspBitmap:TBitmap);
var
pscanLine32,pscanLine32_2: pRGBQuadArray;
nScanLineCount, nPixelCount : Integer;
begin
with ABitmap do
begin
PixelFormat := pf32Bit;
HandleType := bmDIB;
ignorepalette := true;
alphaformat := afDefined;
for nScanLineCount := 0 to Height - 1 do
begin
pscanLine32 := Scanline[nScanLineCount];
pscanLine32_2 := TranspBitmap.Scanline[nScanLineCount];
for nPixelCount := 0 to Width - 1 do
with pscanLine32[nPixelCount] do
begin
// all picels with are not clFuchsia in the transparent bitmap
if NOT ((pscanLine32_2[nPixelCount].rgbBlue=255) AND (pscanLine32_2[nPixelCount].rgbRed=255) AND (pscanLine32_2[nPixelCount].rgbGreen=0) ) then
begin
rgbReserved := 255;
end
else
begin
rgbBlue := 0;
rgbRed := 0;
rgbGreen := 0;
end;
end;
end;
end;
end;
procedure TAForm.FormPaint(Sender: TObject);
var b1,b2,b3:TBitmap;
BF: TBlendFunction;
begin
// Example how it opacity works:
b1 := TBitmap.Create;
b1.SetSize(20,20);
b1.Canvas.Brush.Color := clBlue;
b1.Canvas.Rectangle(0,0,20,20);
Canvas.Draw(10,10,b1,$ff); // Works
Canvas.Draw(40,10,b1,$66); // Works
// I need it in combination with TransparentColor:
b3 := TBitmap.Create;
b3.PixelFormat := pf32Bit;
b2 := TBitmap.Create;
b2.PixelFormat := pf32Bit;
// next 3 lines are different from above
b2.Transparent := true;
b2.TransparentColor := clFuchsia;
b2.Canvas.Brush.Color := clFuchsia;
b2.SetSize(20,20);
b2.Canvas.Brush.Color := clBlue;
b2.Canvas.Ellipse(0,0,20,20);
Canvas.Draw(10,40,b2,$ff); // Works (full opacity)
b3.SetSize(20,20);
SetBitmapAlpha(b3,0);
b3.Canvas.Draw(0,0,b2,$66);
AdaptBitmapAlpha(b3,b2);
Canvas.Draw(40,40,b3,$66);
b1.Free;
b2.Free;
b3.Free;
end;
thanks to bummi (accepted answer)!
i put his solution in a class helper. here is the code if anybody need it:
unit uBitmapHelper;
interface
uses
Vcl.Graphics;
type
TBitmapHelper = class Helper for TBitmap
private
type
TRgbaRec = packed record
r,g,b,a:Byte;
end;
PRgbaRec = ^TRgbaRec;
PRgbaRecArray = ^TRgbaRecArray;
TRgbaRecArray = array [0 .. 0] of TRgbaRec;
public
procedure TransparentMaskedDraw(ACanvas:TCanvas;AX:Integer;AY:Integer;AMask:TColor;AOpacity:Byte);
end;
implementation
{ TBitmapHelper }
procedure TBitmapHelper.TransparentMaskedDraw(ACanvas:TCanvas;AX,AY:Integer;AMask:TColor;AOpacity:Byte);
var i,j:Integer;
line1,line2:PRgbaRecArray;
mask:PRgbaRec;
tmp:TBitmap;
begin
mask := #AMask;
tmp := TBitmap.Create;
tmp.SetSize(self.Width,self.Height);
tmp.PixelFormat := pf32Bit;
tmp.HandleType := bmDIB;
tmp.IgnorePalette := true;
tmp.AlphaFormat := afDefined;
for i := 0 to tmp.Height - 1 do begin
line1 := tmp.Scanline[i];
for j := 0 to tmp.Width - 1 do begin
line1[j].a := 0;
end;
end;
tmp.Canvas.Draw(0,0,self,AOpacity);
for i := 0 to tmp.Height - 1 do begin
line1 := tmp.ScanLine[i];
line2 := self.ScanLine[i];
for j := 0 to tmp.Width - 1 do begin
if not((line2[j].r = mask.r) and (line2[j].g = mask.g) and (line2[j].b = mask.b)) then begin
line1[j].a := $ff;
end else begin
line1[j].r := 0;
line1[j].g := 0;
line1[j].b := 0;
end;
end;
end;
ACanvas.Draw(AX,AY,tmp,AOpacity);
tmp.Free;
end;
end.
The oldest answer is fine, please find some easy reshuffle.
This example also shows how to put one png-image with opacity on another by respecting the transparency.
procedure TForm2.FormCreate(Sender: TObject);
//define your own transparent color by setting RGB-values
const cTransR=255; cTransG=255; cTransB=255;
clTrans= $10000*cTransB + $100*cTransG + cTransR;
var bmp1,bmp2:TBitmap;
pngTemp: TPngImage;
I:integer;
procedure SetAlphaTransparent(VAR LBitmap:TBitmap);
type TRGBQuadArray = ARRAY [0..0] OF TRGBQuad;
var I, J: integer;
LscanLine32:^TRGBQuadArray;
begin
// I found no other way than scanning pixel by pixel to recover default opacity
for I := 0 to LBitmap.Height - 1 do begin
LscanLine32:=LBitmap.ScanLine[I];
for J := 0 to LBitmap.Width - 1 do
with LscanLine32[J] do
if NOT((rgbRed=cTransR)AND(rgbGreen=cTransG)AND(rgbBlue=cTransB)) then
rgbReserved := 255; // make pixel visible, since transparent is default
end;
end;
Procedure SetAlphaProperty(Var LBitmap:TBitmap; LWidth, LHeight:integer);
begin
// You will need a different format Bitmap to allow alpha values
LBitmap.PixelFormat := pf32Bit;
LBitmap.HandleType := bmDIB;
LBitmap.alphaformat := afDefined;
LBitmap.Canvas.Brush.Color := clTrans;
LBitmap.SetSize(LWidth,LHeight);
end;
begin
// create any background on your Form, by placing IMG:Timage on the From
pngTemp := TPngImage.Create;
pngTemp.LoadFromFile( GetCurrentDir()+'\figure1.png' );
IMG.Canvas.Draw((IMG.Width-pngTemp.Width) div 2, // fit png into the center
(IMG.Height-pngTemp.Height) div 2,pngTemp);
pngTemp.Free;
// First example how it opacity works with transparency
bmp1 := TBitmap.Create;
SetAlphaProperty(bmp1,35,35);
// a circle has a surrouding area, to make transparent
bmp1.Canvas.Brush.Color := clBlue;
bmp1.Canvas.Ellipse(5,5,30,30);
SetAlphaTransparent(bmp1);
// show some circles with different opacity
for I := 0 to 7 do
IMG.Canvas.Draw(I*40-30,10,bmp1,(8-I)*32);
bmp1.Free;
// Another example using a different png-file
bmp2 := TBitmap.Create;
SetAlphaProperty(bmp2,Img.Width,Img.Height);
// load a transparent png-file and put it into the alpha bitmap:
pngTemp := TPngImage.Create;
pngTemp.LoadFromFile( GetCurrentDir()+'\figure2.png' );
pngTemp.Transparent := true;
bmp2.Canvas.Draw((bmp2.Width-pngTemp.Width) div 2,// fit png into the center
(bmp2.Height-pngTemp.Height) div 2,pngTemp);
pngTemp.Free;
// draw the second image with transparancy and opacity onto the first one
SetAlphaTransparent(bmp2);
IMG.Canvas.Draw(0,0,bmp2,$66);
bmp2.Free;
end;
I have a code, that draws the message str directly to center of the screen without a visible window.
Why using this code first works OK, but after dozens of calls, it gives Out of system resources.
It seems to free BM ok, and I don't see that it allocates other resources at all.
procedure ttsplash.UpdateSplash(const Str: string);
var
R: TRect;
P: TPoint;
S: TPoint;
bm: TBitmap;
bf: TBlendFunction;
EXSTYLE: DWORD;
x, y: integer;
pixel: PRGBQuad;
TextRed,
TextGreen,
TextBlue: byte;
begin
if str='' then exit;
EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or $80000);
R := ClientRect;
bm := TBitmap.Create;
try
bm.PixelFormat := pf32bit;
// bm.SetSize(ClientWidth, ClientHeight);
bm.Width := clientwidth;
bm.height := clientheight;
bm.Canvas.Brush.Color := clBlack;
bm.Canvas.FillRect(ClientRect);
bm.Canvas.Font.Assign(Self.Font);
bm.Canvas.Font.Color := clWhite;
DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);
TextRed := GetRValue(ColorToRGB(Font.Color));
TextGreen := GetGValue(ColorToRGB(Font.Color));
TextBlue := GetBValue(ColorToRGB(Font.Color));
for y := 0 to bm.Height - 1 do
begin
pixel := bm.ScanLine[y];
x := 0;
while x < bm.Width do
begin
with pixel^ do
begin
rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;
rgbBlue := TextBlue * rgbReserved div 255;
rgbGreen := TextGreen * rgbReserved div 255;
rgbRed := TextRed * rgbReserved div 255;
end;
inc(pixel);
inc(x);
end;
end;
P := Point(0, 0);
S := Point(bm.Width, bm.Height);
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := 255;
bf.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(Handle, 0, nil, #S, bm.Canvas.Handle, #P, 0, #bf, ULW_ALPHA)
finally
bm.Free;
end;
end;
How to debug this.
Enable debug DCUs in your project options, disable optimizations.
When you get out of resources error, hit "Break".
Inspect call stack :
The problem happens in CopyBitmap when calling GDICheck -> double click GDICheck to go there.
Put a breakpoint. Run the program - count how many times it takes before the error shows up and break just before you expect the error.
Have a look around for anything that might be odd. A good place to start is the bitmap itself. Your first clue should be that each time you call this method your text is creeping away up into the corner of your invisible form.
Let's check the bitmap header and see what's going on :
Looks like your bitmap dimensions are negative. I wonder how that happened. In fact, if you watch each time this is called, your bitmap is shrinking each time. In fact, it is shrinking by 16px in width and 38px in height - the size of the window frame.
Each time you are calling UpdateLayeredWindow you are resizing your form (its outside dimension) to be the size of the client area - the size without the window frame. Your new window gets a new frame and the client area shrinks.
Eventually there is nothing left and you are trying to make a bitmap with negative dimensions. You should therefore take into account the frame size when building your bitmap. Use the form width and height rather than the client size :
bm.Width := Width;
bm.height := Height;
Also, when making API calls, please get into the habit of checking the return values for errors, as described in the documentation for the function in question. If you are not checking for errors you are asking for problems.
Without your feedback this remains a guess, but passing a device context with the size of your form's client area, you reduce the size of your form with each call to UpdateLayeredWindow. When, eventually, you request a negative value for the bitmap dimensions, CreateCompatibleBitmap in the code path returns an error.
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;