Delphi code part 3 - Colours

March 6th, 2007 by William Yang

When I first started Delphi programming, I started with very basic stuff like number manipulation and string manipulation. This delphi unit I am going show you is a bit different, its smarter :). When I got tired of working with just numbers and strings, I started to play with colours. From the simple ones to more advanced ones.

For example, how grey colour appeared as RGB value, all the RGB values are equal. The higher the RGB value is the brighter the colour is, $FFFFFF is white, $000000 is black. I averaged two RGB values (compute R,G,B values sperately) to get an merged colour. I added values to RGB to make the colour brighter, and deducted values to make it darker.

Here is the code:

Show Code | Download colorman.pas

  1.  
  2. { ---------------------------------------------------
  3.     Colour Manager   Copyright (r) by DreamFactory
  4.     Version : 1.75   Author : William Yang
  5.     Last Update 09 - Sep - 97
  6.   --------------------------------------------------- }
  7.  
  8. unit ColorMan;
  9.  
  10. interface
  11.  
  12. uses Windows, SysUtils, Graphics, NumMan;
  13.  
  14. type
  15.   TRGB = array[0..2] of Byte;
  16.   PRGBArray = ^TRGBArray;
  17.   TRGBArray = array[0..2000] of TRGB;
  18.  
  19. //Common Used in Quick Basic
  20. function QBColor (n:Integer) : TColor;
  21. function ToQBColor (C: TColor) : Integer;
  22.  
  23. function HexToColor (Hex : String) : TColor; //Transfer Hexidecimal to Color
  24. function HexToInt (Hex : String) : Integer;   //Transfer Hexidecimal to Integer
  25. function BrightenColor(BaseColor: TColor; Adjust : Integer): TColor;
  26.   //Convert the BaseColor to the Grade of Adjust Brighten Color
  27. function DarkenColor(BaseColor: TColor; Adjust : Integer): TColor;
  28.   //Convert the BaseColor to the Grade of Adjust Darken Color
  29. function ColorToGrey(SC : TColor) : TColor; //Convert the SC to Grey Color
  30. function Colorise(SC, MC : TColor) : TColor; //Convert the SC to MC Color
  31. function ERGB(R,G,B : Single) : TColor; //Error RGB Color
  32. function CorrectColor(C : Single) : Integer; //Correct the Wrong Color Byte
  33. function MergeColor(C1, C2 : TColor) : TColor; //Merge Two Color to One
  34. function MiscColor(var C : Variant) : TColor; //Misc A Number of Colors To One
  35. function MiscBmpToColor(SDC : Integer; W, H : Integer; A : TRect) : TColor;
  36. //Misc A Whole BMP to One Color
  37. function IsGreyColor(C : TColor) : Boolean; //Check if the Color is grey color
  38. function IsLightColor(C : TColor) : Boolean; //Check if the Color is Light Color
  39.  
  40. {Added 19-March-1997}
  41. function RGBAvg(C : TColor) : Integer;
  42. function SumRGB(C : TColor) : Integer;
  43. function CompareR(C1, C2 : TColor) : Integer;
  44. function CompareG(C1, C2 : TColor) : Integer;
  45. function CompareB(C1, C2 : TColor) : Integer;
  46. function CompareColor(C1, C2 : TColor) : Integer;
  47.  
  48. function ColorAdd(C1, C2 : TColor) : TColor;
  49. function ColorMinus(C1, C2 : TColor) : TColor;
  50.  
  51. function InvertColor(C: TColor) : TColor;
  52. function CentreRGB(C : TColor; Percent : Integer) : TColor;
  53.  
  54. // 10 July 1997
  55. function MergeColorExt(C1, C2 : TColor; Grade: Byte) : TColor;
  56.  
  57. function AutoBW(BGColor: TColor): TColor;
  58.  
  59. procedure DeColor(Color: TColor; var R, G, B: Integer);
  60.  
  61. // 16 Oct 1997
  62. procedure DeColorB(Color: TColor; var R, G, B: Byte);
  63.  
  64. //1/10/98
  65. function RGBToInt(aRGB: TRGB): Integer;
  66. function IntToRGB(Int: Integer): TRGB;
  67.  
  68. // 11/10/98
  69. function EnhanceColor(Color: TColor; Grade: Integer): TColor;
  70.  
  71. implementation
  72.  
  73. function IsNearColor(Color, CompareTo: TColor; AllowNear: Integer): BOolean;
  74. var
  75.   r,g,b: Integer;
  76.   r1,g1,b1: Integer;
  77. begin
  78.   decolor(color, r, g, b);
  79.   decolor(CompareTo, r1, g1, b1);
  80.   if (r in [r1-allownear..r1+allownear]) and (b in [b1-allownear..b1+allownear]) and
  81.     (g in [g1-allownear..g1+allownear]) then
  82.     Result := True
  83.   else
  84.     Result := False;
  85. end;
  86.  
  87. function EnhanceColor(Color: TColor; Grade: Integer): TColor;
  88. var
  89.   av, r, g, b: Integer;
  90.  
  91. begin
  92.   DeColor(Color, r, g, b);
  93.   av := (r + g + b) div 3;
  94. {  if r > av then Inc(r, Grade) else Dec(r, Grade);
  95.   if g > av then Inc(g, Grade) else Dec(g, Grade);
  96.   if b > av then Inc(b, Grade) else Dec(b, Grade);}
  97.   r := Round(r + (av - r)*(Grade/100));
  98.   g := Round(g + (av - g)*(Grade/100));
  99.   b := Round(b + (av - b)*(Grade/100));
  100.   Result := ERGB(r, g, b);
  101. end;
  102.  
  103. function RGBToInt(aRGB: TRGB): Integer;
  104. begin
  105.   Result := RGB(aRGB[2], aRGB[1], aRGB[0]);
  106. end;
  107.  
  108. function IntToRGB(Int: Integer): TRGB;
  109. begin
  110.   Result[0] := GetBValue(Int);
  111.   Result[1] := GetGValue(Int);
  112.   Result[2] := GetRValue(Int);
  113. end;
  114.  
  115. procedure DeColor(Color: TColor; var R, G, B: Integer);
  116. begin
  117.   R := GetRValue(Color);
  118.   G := GetGValue(Color);
  119.   B := GetBValue(Color);
  120. end;
  121.  
  122. procedure DeColorB(Color: TColor; var R, G, B: Byte);
  123. begin
  124.   R := GetRValue(Color);
  125.   G := GetGValue(Color);
  126.   B := GetBValue(Color);
  127. end;
  128.  
  129.  
  130. function ToQBColor (C: TColor) : Integer;
  131. var
  132.   i : Byte;
  133. begin
  134.   Result := 0;
  135.   for  i := 0 to 15 do
  136.   begin
  137.     if C =QBColor(i) then
  138.     begin
  139.       Result := i;
  140.       Exit;
  141.     end;
  142.   end;
  143. end;
  144.  
  145.  
  146. function AutoBW(BGColor: TColor): TColor;
  147. begin
  148.   if IsLightColor(BGColor) then
  149.     Result := clBlack
  150.   else
  151.     Result := clWhite;
  152. end;
  153.  
  154. function CentreRGB(C : TColor; Percent : Integer) : TColor;
  155. var
  156.   Avg : Integer;
  157.   R, G, B : Integer;
  158. begin
  159.   Avg := RGBAvg(C);
  160.   R := GetRValue(C);
  161.   G := GetGValue(C);
  162.   B := GetBValue(C);
  163.   R := R - (R - Avg) * Percent;
  164.   G := G - (G - Avg) * Percent;
  165.   B := B - (B - Avg) * Percent;
  166.   Result := RGB(R,G,B);
  167. end;
  168.  
  169. function InvertColor(C: TColor) : TColor;
  170. begin
  171.   Result := RGB(255 - GetRValue(C), 255 - GetGValue(C), 255 - GetBValue(C));
  172. end;
  173.  
  174. function ColorAdd(C1, C2 : TColor) : TColor;
  175. begin
  176.   Result := ERGB(GetRValue(C1) + GetRValue(C2), GetGValue(C1) + GetGValue(C2),
  177.     GetBValue(C1) + GetBValue(C2));
  178. end;
  179.  
  180. function ColorMinus(C1, C2 : TColor) : TColor;
  181. begin
  182.   Result := ERGB(GetRValue(C1) - GetRValue(C2), GetGValue(C1) - GetGValue(C2),
  183.     GetBValue(C1) - GetBValue(C2));
  184. end;
  185.  
  186. function CompareR(C1, C2 : TColor) : Integer;
  187. begin
  188.   Result := GetRValue(C1) - GetRValue(C2);
  189. end;
  190.  
  191. function CompareG(C1, C2 : TColor) : Integer;
  192. begin
  193.   Result := GetGValue(C1) - GetGValue(C2);
  194. end;
  195.  
  196. function CompareB(C1, C2 : TColor) : Integer;
  197. begin
  198.   Result := GetBValue(C1) - GetBValue(C2);
  199. end;
  200.  
  201. function CompareColor(C1, C2 : TColor) : Integer;
  202. begin
  203.   Result := RGBAvg(C1) - RGBAvg(C2);
  204. end;
  205.  
  206. function SumRGB(C : TColor) : Integer;
  207. begin
  208.   Result := GetRValue(C) + GetGValue(C) + GetBValue(C);
  209. end;
  210.  
  211. function RGBAvg(C : TColor) : Integer;
  212. begin
  213.   Result := SumRGB(C) div 3;
  214. end;
  215.  
  216. function IsLightColor(C : TColor) : Boolean;
  217. var
  218.   Count : Integer;
  219. begin
  220.   Count := 0;
  221. { Check if any of these value is more than a half of 255 }
  222.   C := ColorToGrey(C);
  223.   if GetRValue(C) < 128 then Count := Count + 1;
  224.   if GetGValue(C) < 128 then Count := Count + 1;
  225.   if GetBValue(C) < 128 then Count := Count + 1;
  226.  
  227.   {-------------------------------------------
  228.   |   0      |---|---|---|---|     255       |
  229.   |   Black                        White     |
  230.   -------------------------------------------}
  231.  
  232.   if Count > 1 then
  233.     Result := False
  234.   else
  235.     Result := True;
  236. end;
  237.  
  238.  
  239. function IsGreyColor(C : TColor) : Boolean;
  240. begin
  241.   {A Grey Color is combined with eque R,G,B Value}
  242.   {Check if Red = Green, Blue = Green }
  243.   if (GetRValue(C) = GetGValue(C)) and (GetBValue(C) = GetGValue(C)) then
  244.     Result := True
  245.   else
  246.     Result := False;
  247. end;
  248.  
  249. {
  250. This function is written after the MiscColor, because I thought the Variant
  251. Parameter Make the tranfering too slow.
  252. }
  253.  
  254. function MiscBmpToColor(SDC : Integer; W, H : Integer; A : TRect) : TColor;
  255. var
  256.   C, k, i, j : Integer;
  257.   pR, pG, pB : LongInt;
  258. begin
  259.   K := 0; pR := 0; pG := 0; pB := 0;
  260.   for i := A.Left to A.Right do
  261.    for j := A.Top to A.Bottom do
  262.     begin
  263.       if not ((i < 0) or (j <= 0) or (i > W) or (j > H)) then
  264.       begin
  265.         C := GetPixel(SDC, i, j);
  266.         Inc(pR, GetRValue(C));
  267.         Inc(pG, GetGValue(C));
  268.         inc(pB, GetBValue(C));
  269.         k := k + 1;
  270.       end;
  271.     end;
  272.   pR := Round( pR / k );
  273.   pB := Round( pB / k );
  274.   pG := Round( pG / k );
  275.   Result := RGB(pR, pG, pB);
  276. end;
  277.  
  278.  
  279. function MergeColor(C1, C2 : TColor) : TColor;
  280. begin
  281.   Result := MergeColorExt(C1, C2, 50);
  282. end;
  283.  
  284. function MergeColorExt(C1, C2 : TColor; Grade: Byte) : TColor;
  285. var
  286.   pR, pG, pB : Single;
  287. begin
  288.   pR := (GetRValue(C1) * Grade / 100 + GetRValue(C2) * (100-Grade) / 100);
  289.   pG := (GetGValue(C1) * Grade / 100 + GetGValue(C2) * (100-Grade) / 100);
  290.   pB := (GetBValue(C1) * Grade / 100 + GetBValue(C2) * (100-Grade) / 100);
  291.   Result := ERGB(pR, pG, pB);
  292. end;
  293.  
  294. function MiscColor(var C : Variant) : TColor;
  295. var
  296.   pR, pG, pB : LongInt;
  297.   Count, i, l, h : Integer;
  298. begin
  299.  
  300. end;
  301.  
  302. function CorrectColor(C : Single) : Integer;
  303. begin
  304.   Result := Round(C);
  305.   if Result > 255 then Result := 255;
  306.   if Result < 0 then Result := 0;
  307. end;
  308.  
  309. function ERGB(R,G,B : Single) : TColor;
  310. begin
  311.   Result := RGB(CorrectColor(R), CorrectColor(G), CorrectColor(B));
  312. end;
  313.  
  314. function Colorise(SC, MC : TColor) : TColor;
  315. var
  316.  
  317. pR, pG, pB : Single;
  318. begin
  319.   // take the each percentage of r, g, b in the given color
  320.   pR := GetRValue(MC) / 255 + 1;
  321.   pG := GetGValue(MC) / 255 + 1;
  322.   pB := GetBValue(MC) / 255 + 1;
  323.  
  324.   Result := ColorToGrey(SC);
  325.   Result := ERGB(pR * GetRValue(Result), pG * GetGValue(Result), pB * GetBValue(Result));
  326.  
  327. end;
  328.  
  329. function ColorToGrey(SC : TColor) : TColor;
  330. var
  331.   avg : Integer;
  332. begin
  333.   avg := Round((GetRValue(SC) * 20 + GetGValue(SC) * 50 + GetBValue(SC)*30)/100);
  334.   Result := RGB(avg, avg, avg);
  335. end;
  336.  
  337. function QBColor (n:Integer):TColor;
  338. var
  339.    C:TColor;
  340. begin
  341.      case n of
  342.           0: C := 0;
  343.           1: C := clNavy;
  344.           2: C := 32768;
  345.           3: C := 8421376;
  346.           4: C := 128;
  347.  
  348.           5: C := 8388736;
  349.           6: C := 32896;
  350.           7: C := 12632256;
  351.  
  352.           8: C := 8421504;
  353.           9: C := 16711680;
  354.           10: C := 65280;
  355.           11: C := 16776960;
  356.           12: C := 255;
  357.           13: C := 16711935;
  358.           14: C := clYellow;
  359.           15: C := clWhite;
  360.      end;
  361.      Result := C;
  362. end;
  363.  
  364. function HexToColor(Hex:String) : TColor;
  365. var
  366.   RHex : string;
  367. begin
  368.   RHex := '$' + Hex;
  369.   Result := StrToInt(RHex);
  370. end;
  371.  
  372. function HexToInt(Hex:String) : Integer;
  373. var
  374.   RHex : string;
  375. begin
  376.   RHex := '$' + Hex;
  377.   Result := StrToInt(RHex);
  378. end;
  379.  
  380. function BrightenColor(BaseColor: TColor; Adjust : Integer): TColor;
  381. begin
  382.   BaseColor := ColorToRGB(BaseColor);
  383.   Result := ERGB(GetRValue(BaseColor) + Adjust, GetGValue(BaseColor) + Adjust,
  384.     GetBValue(BaseColor) + Adjust);
  385. end;
  386.  
  387. function DarkenColor(BaseColor: TColor; Adjust : Integer): TColor;
  388. begin
  389.   Result := BrightenColor(BaseColor, -Adjust);
  390. end;
  391.  
  392. end.
  393.  
  394.  
  395.  
  396.  
  397.  

This entry was posted on Tuesday, March 6th, 2007 at 2:00 pm and is filed under Delphi, Delphi code. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.

« Delphi code part 2 - Strings
7 PHP quick coding methods »

Leave a Reply