Recent

Author Topic: How to darken/enlight a TColor on run-time  (Read 578 times)

Raul_ES

  • Full Member
  • ***
  • Posts: 174
  • My interests: Healthcare & Computers
    • My Linkedin Profile, you can add me to stay in contact.
How to darken/enlight a TColor on run-time
« on: June 12, 2020, 12:19:28 am »
Hello,

I was wondering how to get a color from the palette like clForm or clGray and darken it in run-time, for example a 5% or 12%. And the opposite, to enlight the color a 20% for example.

Let's say that I have certains controls that I want them to be a little bit more darker than the parent form color.

regards
Pharmacy + Chemistry + Biology + Healthcare + Computing

If you have any interest or project related with these areas feel free to contact me!

Blaazen

  • Hero Member
  • *****
  • Posts: 2912
  • POKE 54296,15
    • Eye-Candy Controls
Re: How to darken/enlight a TColor on run-time
« Reply #1 on: June 12, 2020, 01:19:21 am »
The simpliest way is to use unit GraphUtil which has three functions:
Code: Pascal  [Select][+][-]
  1.  function ColorAdjustLuma(clrRGB: TColor; n: Integer; fScale: BOOL): TColor;
  2.  function GetHighLightColor(const Color: TColor; Luminance: Integer = 19): TColor;
  3.  function GetShadowColor(const Color: TColor; Luminance: Integer = -50): TColor;
Lazarus 2.1.0 r63881 FPC 3.3.1 r40507 x86_64-linux-qt Chakra, Qt 4.8.7/5.13.2, Plasma 5.17.3
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

Raul_ES

  • Full Member
  • ***
  • Posts: 174
  • My interests: Healthcare & Computers
    • My Linkedin Profile, you can add me to stay in contact.
Re: How to darken/enlight a TColor on run-time
« Reply #2 on: June 12, 2020, 01:53:21 am »
Thanks!
Pharmacy + Chemistry + Biology + Healthcare + Computing

If you have any interest or project related with these areas feel free to contact me!

circular

  • Hero Member
  • *****
  • Posts: 3440
    • Personal webpage
Re: How to darken/enlight a TColor on run-time
« Reply #3 on: June 12, 2020, 10:33:00 am »
Note that you may need to call ColorToRGB with the system color to get an actual color.
Conscience is the debugger of the mind

furious programming

  • Sr. Member
  • ****
  • Posts: 467
  • I click a little.
    • TreeStructInfo — format for text and binary configuration files
Re: How to darken/enlight a TColor on run-time
« Reply #4 on: June 12, 2020, 05:01:45 pm »
Below are two procedures that I use to darken or lighten entire 24-bit bitmaps in the Deep Platformer project. They are very effective due to the use of ScanLine. If you are not interested in modifying the brightness of the whole bitmap, focus on three lines performing calculations (I highlighted them).

The second parameter is the level of dimming/lightening, which can have a value from 0 to 255. 0 means that nothing will be changed, and 255 means full darkening or brightening. So the higher the value of this parameter, the stronger the change.

Code: Pascal  [Select][+][-]
  1. type
  2.   TBitmapPixel = record
  3.     B, G, R: UInt8;
  4.   end;
  5.  
  6. type
  7.   PBitmapLine = ^TBitmapLine;
  8.   TBitmapLine = array [UInt16] of TBitmapPixel;
  9.  
  10.  
  11. procedure DarkenBuffer(ABuffer: TBitmap; ALevel: UInt8);
  12. var
  13.   Line: PBitmapLine;
  14.   LineIndex, PixelIndex: Integer;
  15. begin
  16.   ALevel := 255 - ALevel;
  17.   ABuffer.BeginUpdate();
  18.  
  19.   for LineIndex := 0 to ABuffer.Height - 1 do
  20.   begin
  21.     Line := ABuffer.ScanLine[LineIndex];
  22.  
  23.     for PixelIndex := 0 to ABuffer.Width - 1 do
  24.       with Line^[PixelIndex] do
  25.       begin
  26.         B := B * ALevel shr 8;
  27.         G := G * ALevel shr 8;
  28.         R := R * ALevel shr 8;
  29.       end;
  30.   end;
  31.  
  32.   ABuffer.EndUpdate();
  33. end;
  34.  
  35.  
  36. procedure LightenBuffer(ABuffer: TBitmap; ALevel: UInt8);
  37. var
  38.   Line: PBitmapLine;
  39.   LineIndex, PixelIndex: Integer;
  40. begin
  41.   ALevel := 255 - ALevel;
  42.   ABuffer.BeginUpdate();
  43.  
  44.   for LineIndex := 0 to ABuffer.Height - 1 do
  45.   begin
  46.     Line := ABuffer.ScanLine[LineIndex];
  47.  
  48.     for PixelIndex := 0 to ABuffer.Width - 1 do
  49.       with Line^[PixelIndex] do
  50.       begin
  51.         B := Round(B * ALevel / 255 + 255 - ALevel);
  52.         G := Round(G * ALevel / 255 + 255 - ALevel);
  53.         R := Round(R * ALevel / 255 + 255 - ALevel);
  54.       end;
  55.   end;
  56.  
  57.   ABuffer.EndUpdate();
  58. end;

If you are interested in the percentage mixing of two colors, below is a simple procedure for doing this task. The parameter determining the level of mixing is the percentage, i.e. a value from 0 to 100:

Code: Pascal  [Select][+][-]
  1. type
  2.   TRGBTriple = packed record
  3.     B, G, R: UInt8;
  4.   end;
  5.  
  6. function CombineColors(AColorA, AColorB: TColor; APercent: UInt8): TColor;
  7. var
  8.   ColorA, ColorB, ColorDest: TRGBTriple;
  9. begin
  10.   RedGreenBlue(AColorA, ColorA.R, ColorA.G, ColorA.B);
  11.   RedGreenBlue(AColorB, ColorB.R, ColorB.G, ColorB.B);
  12.  
  13.   ColorDest.R := Round(ColorA.R + (ColorB.R - ColorA.R) / 100 * APercent);
  14.   ColorDest.G := Round(ColorA.G + (ColorB.G - ColorA.G) / 100 * APercent);
  15.   ColorDest.B := Round(ColorA.B + (ColorB.B - ColorA.B) / 100 * APercent);
  16.  
  17.   Result := RGBToColor(ColorDest.R, ColorDest.G, ColorDest.B);
  18. end;

This algorithm is useful — with it you can combine two images and create a smooth transition between them:

Code: Pascal  [Select][+][-]
  1. procedure CombineImages(AImageA, AImageB, AImageDest: TPortableNetworkGraphic; ALevel, AScale: UInt8);
  2. type
  3.   PPNGPixel = ^TPNGPixel;
  4.   TPNGPixel = record B, G, R, A: UInt8; end;
  5. type
  6.   PPNGLine = ^TPNGLine;
  7.   TPNGLine = array [UInt16] of TPNGPixel;
  8. var
  9.   LineA, LineB, LineDest: PPNGLine;
  10.   PixelA, PixelB, PixelDest: PPNGPixel;
  11. var
  12.   LineIndex, PixelIndex: Integer;
  13. begin
  14.   AImageDest.BeginUpdate();
  15.   try
  16.     for LineIndex := 0 to AImageA.Height - 1 do
  17.     begin
  18.       LineA := AImageA.ScanLine[LineIndex];
  19.       LineB := AImageB.ScanLine[LineIndex];
  20.       LineDest := AImageDest.ScanLine[LineIndex];
  21.  
  22.       for PixelIndex := 0 to AImageA.Width - 1 do
  23.       begin
  24.         PixelA := @LineA^[PixelIndex];
  25.         PixelB := @LineB^[PixelIndex];
  26.         PixelDest := @LineDest^[PixelIndex];
  27.  
  28.         PixelDest^.R := Round(PixelA^.R + (PixelB^.R - PixelA^.R) / AScale * ALevel);
  29.         PixelDest^.G := Round(PixelA^.G + (PixelB^.G - PixelA^.G) / AScale * ALevel);
  30.         PixelDest^.B := Round(PixelA^.B + (PixelB^.B - PixelA^.B) / AScale * ALevel);
  31.       end;
  32.     end;
  33.   finally
  34.     AImageDest.EndUpdate();
  35.   end;
  36. end;

This time the procedure operates on 24-bit PNG images, but nothing prevents you from adding alpha channel support or bitmap support. The first two parameters are source images, the third parameter is the target image.

The AScale parameter determines the sensitivity and can have a value e.g. 100 (percentage mixing) or another value, e.g. 255. The ALevel parameter specifies the level of color mixing and must be between 0 and AScale. The higher the AScale value, the more levels of color mixing available.


To the attachments I add the sources of both small tools, which I created a long time ago to test the above two algorithms (used on Windows). Feel free to use them.
« Last Edit: June 12, 2020, 05:28:42 pm by furious programming »
Lazarus 2.0.10 with FPC 3.2.0 (SVN Revision 63526), Windows XP (all 32-bit)

Raul_ES

  • Full Member
  • ***
  • Posts: 174
  • My interests: Healthcare & Computers
    • My Linkedin Profile, you can add me to stay in contact.
Re: How to darken/enlight a TColor on run-time
« Reply #5 on: June 15, 2020, 01:08:32 pm »
Thank you very much for your help.


regards
Pharmacy + Chemistry + Biology + Healthcare + Computing

If you have any interest or project related with these areas feel free to contact me!

 

TinyPortal © 2005-2018