home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / colorwhl.zip / ColorMapping.pas next >
Pascal/Delphi Source File  |  1999-06-20  |  2KB  |  136 lines
  1. Unit ColorMapping;
  2.  
  3. Interface
  4.  
  5. Uses
  6.   Classes;
  7.  
  8. // IN these functions the following definitions apply:
  9. // Hue: 0 - 1535
  10. //   red = 0  green = 512  blue = 1024
  11. // Saturation: 0 - 1
  12. //   grey (no color) = 0  max color = 1
  13. // Value: 0 - 1
  14. //   black =0   max brightness = 1
  15. Procedure RGBToHSV( C: TColor;
  16.                     Var Hue: longint;
  17.                     Var Saturation, Value: real );
  18.  
  19. Function HSVToRGB( const H: longint; const S, V: real ): TColor;
  20.  
  21. Function Min( a, b: longint ): longint;
  22.  
  23. Function Max( a, b: longint ): longint;
  24.  
  25. Implementation
  26.  
  27. Function Min( a, b: longint ): longint;
  28. Begin
  29.   if a>b then
  30.     Result:=b
  31.   else
  32.     Result:=a;
  33. End;
  34.  
  35. Function Max( a, b: longint ): longint;
  36. Begin
  37.   if a>b then
  38.     Result:=a
  39.   else
  40.     Result:=b;
  41. End;
  42.  
  43. Procedure RGBToHSV( C: TColor;
  44.                     Var Hue: longint;
  45.                     Var Saturation, Value: real );
  46. Var
  47.   r,g,b: longint;
  48.   hi, lo: longint;
  49.   d: longint;
  50. Begin
  51.   r:= (c div 65536) and 255;
  52.   g:= (c div 256) and 255;
  53.   b:=  c and 255;
  54.   hi:= max( max( r, g ), b );
  55.   lo:= min( min( r, g ), b );
  56.   d:= hi-lo;
  57.   Value:= hi/256;
  58.   if d>0 then
  59.   begin
  60.     if r=hi then
  61.       Hue:= 256*(g-b)/d
  62.     else if g=hi then
  63.       Hue:= 512+256*(b-r)/d
  64.     else
  65.       Hue:= 1024+256*(r-g)/d;
  66.     if Hue<0 then
  67.       Hue:= Hue+1536;
  68.   end
  69.   else
  70.     Hue:= 0; // doesn't matter (grey: Sat = 0)
  71.  
  72.   if hi>0 then
  73.     Saturation:= d/hi
  74.   else
  75.     Saturation:= 0; // doesn't matter (black: Val = 0
  76. End;
  77.  
  78. Function HSVToRGB( const H: longint; const S, V: real ):TColor;
  79. Var
  80.   r,g,b: longint;
  81. Begin
  82.   if ( h<0 ) or ( h>1535 )
  83.      or ( S<0 ) or ( S>1 )
  84.      or ( V<0 ) or ( V>1 ) then
  85.   begin
  86.     // Invalid value, use black
  87.     Result:= 0;
  88.     exit;
  89.   end;
  90.   case h div 256 of
  91.   0:
  92.    begin
  93.     r:= 255;
  94.     g:= h;
  95.     b:= 0;
  96.    end;
  97.   1:
  98.    begin
  99.     r:= 511-h;
  100.     g:= 255;
  101.     b:= 0;
  102.    end;
  103.   2:
  104.    begin
  105.     r:= 0;
  106.     g:= 255;
  107.     b:= h-512;
  108.    end;
  109.   3:
  110.    begin
  111.     r:= 0;
  112.     g:= 1023-h;
  113.     b:= 255;
  114.    end;
  115.   4:
  116.    begin
  117.     r:= h-1024;
  118.     g:= 0;
  119.     b:= 255;
  120.    end;
  121.   5:
  122.    begin
  123.     r:= 255;
  124.     g:= 0;
  125.     b:= 1535-h;
  126.    end;
  127.   end;
  128.   r:= V*( 255- S*(255-r) );
  129.   g:= V*( 255- S*(255-g) );
  130.   b:= V*( 255- S*(255-b) );
  131.   Result:= b + 256*g + 65536*r;
  132. end;
  133.  
  134. Initialization
  135. End.
  136.