Load image to TImage and change it's color

ST3VO
ST3VO used Ask the Experts™
on
Hi all,

I have an image of a single color.
I need to load it into a TImaage and Change it's color using to TColor picker or hex color if possible.
Any ideas anyone pls?

thx

st3vo
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
If it has a single color, then it is a filled rectangle

procedure ChangeColor(img:TImage;Color:TColor);
begin
 With img.Picture.Canvas do
  begin
   Brush.Color:=Color;  // The color from ColorPicker
   Brush.Style:=bsSolid;
   FillRect(Rect(0,0,img.Width,img.Height));
  end;
end;

if by a single color you mean in fact 2 colors, let's say white + another that needs to be changed then

procedure ChangeColor(img:TImage;Color:TColor);
Var X,Y:Integer;
begin
 With img.Picture.Canvas do for Y:=0 to img.Height-1 do for X:=0 to img.Width-1 do
  begin
   if Pixels[X,Y]<>clWhite Then Pixels[X,Y]:=Color;
  end;
end;
Geert GOracle dba
Top Expert 2009

Commented:
if it's just a square or circle you need to change color,
you can also use a TShape
I've done something like that in a hobby project. www.gemeenteleven.nl\pictoselector\index_en.html

The code segment is part of some utility functions. You will need Graphics and Math to be used.

If will take the picture, use the given color, so black will become red etc. Optionally you can make all the white in the image transparant.

Type
  // Assumes a 32 bit TBitmap pixel type  i.e. TBitmap.PixelFormat := pf32bit;
  RGB_Pixel = Packed Record  // Variant record allow two separate fields to occupy the same memory space
                Case LongWord of
                  0 : ( Blue, Green, Red, Alpha : Byte );  // This is Windows specific as an RGB pixel has its colour channels ordered in a specific way i.e. ABGR rather than the usual RGBA
                  1 : ( All_Channels : LongWord );         // The above colour components can be accessed as a single unsigned 32-bit integer when All_Channels field is accessed.
                End;                                       // This is useful for performing AND, XOR, OR and other bitwise manipulations on an entire pixel
 
  // A pointer to the above pixel record type
  RGB_Pixel_Pointer = ^RGB_Pixel;
 
  {
  An array of the above RGB pixel type which makes it easy to access a region
  of memory containing a series of RGB pixels. This is used by many graphics
  filters or rendering routines.
 
  Packed Array forces the individual fields to be aligned close together in memory.
  Some operating systems or compilers, if not declared as packed, would align fields on 16-bit or 32-bit boundaries
  depending upon the size of an individual field.  The Delphi specific identifier "Packed"
  gives us the ability to force record fields to be close together with no free byte space in between.
 
  An array of this size allows us to access a scanline in a bitmap that
  has a maximum width of 32767 pixels, Increase this if you need to
  access larger bitmaps.
  }
  Array_of_RGB_Pixels = Packed Array[ 0..32767 ] of RGB_Pixel;
 
  {
  A pointer to an Array of RGB pixels which makes it easy to access a region
  of memory containing a series of RGB pixels. This is used by many graphics
  filters or rendering routines that need to facilitate pointer arithmetic
  or memory address manipulation on a whole series of RGB pixels.
  }
  Pointer_to_Array_of_RGB_Pixels = ^Array_of_RGB_Pixels;
 
procedure FillPictoColor(bmp: TBitmap; clr: TColor; blnWhiteIsTransparant: boolean);
var
  x,y: integer;
  bmpScan: Pointer_to_Array_of_RGB_Pixels;
  pxlNewColor: RGB_Pixel;
  pxl: RGB_Pixel;
begin
  pxlNewColor.Red := GetRValue(clr);
  pxlNewColor.Green := GetGValue(clr);
  pxlNewColor.Blue := GetBValue(clr);
  pxlNewColor.Alpha := $ff;
 
  bmp.PixelFormat := pf32bit;
  for y := 0 to bmp.Height -1  do begin
    bmpScan := bmp.ScanLine[y];
    for x := 0 to bmp.Width - 1 do begin
      pxl := bmpScan[x];
 
      pxl.Alpha := $ff;
      pxl.Red   := min(pxlNewColor.Red + pxl.Red, 255);
      pxl.Green := min(pxlNewColor.Green + pxl.Green, 255);
      pxl.Blue  := min(pxlNewColor.Blue + pxl.Blue, 255);
      if blnWhiteIsTransparant then begin
        if (pxl.All_Channels and $00FFFFFF) = $00FFFFFF then
          pxl.Alpha := 0;
      end;
      bmpScan[x] := pxl;
    end;
  end;
end;

Open in new window

Learn Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

Author

Commented:
All of these samples have errors and cannot compile to try them.
Could you please post a working example?

thx
Emmanuel PASQUIERFreelance Project Manager
Top Expert 2010

Commented:
Well, we are not exactly sure about what you want exactly. Is it one of the two I provided ?
MvanderKooij version is probably not exactly what you need because it's pretty much sophisticated, I don't see how it could match your question.
If none of these answers seems to correspond to your need, then specify more. Otherwise we surely could make one of those work for you
Freelance Project Manager
Top Expert 2010
Commented:
I've tested this, it works. I've improved it so that you can specify the color to change, and it supports TImage that are not on autosize with the underlying picture

You can download a working app, if that is what you're looking for. First click in the empty area to load an image. Then right click on it to select a color to change, then select a color in a TColorBox (lousy component, but you can improve that after) and click on the change color button. Voila !

https://filedb.experts-exchange.com/incoming/ee-stuff/7768-TestColor.rar
procedure ChangeColor(img:TImage;ColorFrom,ColorTo:TColor);
Var X,Y:Integer;
begin
 With img.Picture.Bitmap.Canvas do for Y:=0 to img.Picture.Height-1 do for X:=0 to img.Picture.Width-1 do
  begin
   if Pixels[X,Y]=ColorFrom Then Pixels[X,Y]:=ColorTo;
  end;
end;

Open in new window

Author

Commented:
Thanks :o)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial