1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-04 22:52:15 -05:00
Simba/Units/MMLCore/colour_conv.pas

390 lines
9.5 KiB
ObjectPascal
Raw Normal View History

{
This file is part of the Mufasa Macro Library (MML)
Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer
MML is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
MML is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with MML. If not, see <http://www.gnu.org/licenses/>.
See the file COPYING, included in this distribution,
for details about the copyright.
Colour Conversion Utilities for the Mufasa Macro Library
}
unit colour_conv;
{$mode objfpc}{$H+}
{$Inline on}
interface
uses
Classes, SysUtils,
Graphics, mufasatypes,
Math;
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
Function RGBtoColor(r,g,b : integer) : TColor; overload; inline;
Procedure ColorToRGB(Color : integer;out r,g,b : byte); overload; inline;
Procedure ColorToRGB(Color : integer;out r,g,b : integer); overload; inline;
Procedure RGBToXYZ(R,G,B : byte;out x,y,z : Extended); inline;
Procedure XYZToRGB(X,Y,Z : Extended;out R,G,B: byte); inline;
Procedure RGBToHSL(RR,GG,BB : byte;out H,S,L : Extended); inline;
Procedure RGBToHSLNonFixed(RR,GG,BB : byte;out H,S,L : Extended); inline;
Procedure HSLtoRGB(H,S,L : extended;out R,G,B : Byte); inline;
Procedure ColorToHSL(Col: Integer; out h, s, l: Extended); inline;
procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
function XYZToColor(X, Y, Z: Extended): TColor; inline;
function HSLToColor(H, S, L: Extended): TColor; inline;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
2011-06-05 13:44:52 -04:00
procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended);
procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended);
implementation
Const
OneDivThree = 1/3.0;
TwoDivThree = 2 / 3.0;
OneDivTwoPointFour = 1 / 2.4;
function BGRToRGB(BGR : TRGB32) : TColor;inline;
begin;
Result := BGR.R or BGR.g shl 8 or BGR.b shl 16;
end;
Function RGBtoColor(r,g,b : byte): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to a TColor.
R, G and B are integers.
/\}
Function RGBtoColor(r,g,b : integer): TColor; overload; inline;
begin;
Result := R or g shl 8 or b shl 16;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are bytes.
/\}
Procedure ColorToRGB(Color : integer;out r,g,b : byte); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given win-32 color in the Red (R), Green (G) and Blue (B)
components. R, G and B are integers.
/\}
Procedure ColorToRGB(Color : integer;out r,g,b : integer); overload; inline;
begin
R := Color and $ff;
G := Color shr 8 and $ff;
B := Color shr 16 and $ff;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
X, Y and Z components.
/\}
Procedure RGBToXYZ(R,G,B : byte;out x,y,z : Extended); inline;
var
Red,Green,Blue : Extended;
begin;
Red := R / 255;
Green := G / 255;
Blue := B / 255;
if Red > 0.04045 then
Red := Power( ( Red + 0.055 ) / 1.055 , 2.4) * 100
else
2010-12-12 05:49:50 -05:00
Red := Red * 7.73993808;
if Green > 0.04045 then
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
else
2010-12-12 05:49:50 -05:00
Green := Green * 7.73993808;
if Blue > 0.04045 then
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
else
2010-12-12 05:49:50 -05:00
Blue := Blue * 7.73993808;
X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;
{/\
Translates the given X, Y and Z components to
Red (R), Green (G) and Blue (B) components.
/\}
Procedure XYZToRGB(X,Y,Z : Extended;out R,G,B: byte); inline;
var
TempR,TempG,TempB,Tempx,tempy,tempz : Extended;
begin;
Tempx := X / 100;
tempy := Y / 100;
tempz := Z / 100;
TempR := Tempx * 3.2406 + tempy * -1.5372 + tempz * -0.4986;
TempG := Tempx * -0.9689 + tempy * 1.8758 + tempz * 0.0415;
TempB := Tempx * 0.0557 + tempy * -0.2040 + tempz * 1.0570;
if TempR > 0.0031308 then
TempR := 1.055 * ( Power(TempR, (OneDivTwoPointFour)) ) - 0.055
else
TempR := 12.92 * TempR;
if TempG > 0.0031308 then
TempG := 1.055 * ( Power(TempG, ( OneDivTwoPointFour)) ) - 0.055
else
TempG := 12.92 * TempG;
if TempB > 0.0031308 then
TempB := 1.055 * ( Power(TempB , ( OneDivTwoPointFour )) ) - 0.055
else
TempB := 12.92 * TempB;
R := Round(TempR * 255);
G := Round(TempG * 255);
B := Round(TempB * 255);
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
H (Hue), S (Saturation) and L (Luminance) components.
/\}
Procedure RGBToHSL(RR,GG,BB : byte;out H,S,L : Extended); inline;
var
R, G, B, D, Cmax, Cmin: Extended;
begin
R := RR / 255;
G := GG / 255;
B := BB / 255;
CMin := R;
if G < Cmin then Cmin := G;
if B < Cmin then Cmin := B;
CMax := R;
if G > Cmax then Cmax := G;
if B > Cmax then Cmax := B;
L := 0.5 * (Cmax + Cmin);
if Cmax = Cmin then
begin
H := 0;
S := 0;
end else
begin;
D := Cmax - Cmin;
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
H := 2 + (B - R) / D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
H := H * 100;
S := S * 100;
L := L * 100;
end;
{/\
Translates the given Red (R), Green (G) and Blue (B) components to
H (Hue), S (Saturation) and L (Luminance) components.
This function does not multiply it by 100.
/\}
Procedure RGBToHSLNonFixed(RR,GG,BB : byte;out H,S,L : Extended); inline;
var
R, G, B, D, Cmax, Cmin: Extended;
begin
R := RR / 255;
G := GG / 255;
B := BB / 255;
CMin := R;
if G < Cmin then Cmin := G;
if B < Cmin then Cmin := B;
CMax := R;
if G > Cmax then Cmax := G;
if B > Cmax then Cmax := B;
L := 0.5 * (Cmax + Cmin);
if Cmax = Cmin then
begin
H := 0;
S := 0;
end else
begin;
D := Cmax - Cmin;
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
if R = Cmax then
H := (G - B) / D
else
if G = Cmax then
H := 2 + (B - R) / D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
end;
{/\
Translates the given H (Hue), S (Saturation) and L (Luminance) components to
Red (R), Green (G) and Blue (B) components.
/\}
procedure HSLtoRGB(H, S, L: extended; out R, G, B: Byte); inline;
var
Temp,Temp2 : Extended;
//begin
Function Hue2RGB(TempHue : Extended) : integer;
begin;
if TempHue < 0 then
TempHue := TempHue + 1
else if TempHue > 1 then
TempHue := TempHue - 1;
if ( ( 6 * TempHue ) < 1 ) then
Result :=Round(255 * (( Temp + ( Temp2 - Temp ) * 6 * TempHue )))
else if ( ( 2 * TempHue ) < 1 ) then
Result :=Round(255 * Temp2)
else if ( ( 3 * TempHue ) < 2 ) then
Result :=Round(255 * (Temp + ( Temp2 - Temp ) * ( ( TwoDivThree ) - TempHue ) * 6))
else
Result :=Round(255 * Temp);
end;
begin;
H := H / 100;
S := S / 100;
L := L / 100;
if s = 0 then
begin;
R := Byte(Round(L * 255));
G := R;
B := R;
end else
begin;
if (L < 0.5) then
Temp2 := L * ( 1 + S )
else
Temp2 := (L + S) - ( S * L);
Temp := 2 * L - Temp2;
R := Hue2RGB( H + ( OneDivThree ) );
G := Hue2RGB( H );
B := Hue2RGB( H - ( OneDivThree ) );
end;
end;
{/\
Split the Given Color col in H, S, L components.
/\}
Procedure ColorToHSL(Col: Integer; out h, s, l: Extended); inline;
Var
R, G, B: byte;
Begin
ColorToRGB(Col, R, G, B);
RGBToHSL(R, G, B, H, S, L);
End;
procedure ColorToXYZ(color: Integer; out X, Y, Z: Extended); inline;
var
R, G, B: byte;
begin
ColorToRGB(Color, R, G, B);
RGBToXYZ(R, G, B, X, Y, Z);
end;
function HSLToColor(H, S, L: Extended): TColor; inline;
var
r, g, b: byte;
begin
HSLToRGB(H, S, L, r, g, b);
Result := RGBToColor(r, g, b);
end;
function XYZToColor(X, Y, Z: Extended): TColor; inline;
var
r, g, b: byte;
begin
XYZToRGB(X, Y, Z, r, g, b);
Result := RGBToColor(r, g, b);
end;
2011-06-05 13:44:52 -04:00
procedure XYZtoCIELab(X, Y, Z: Extended; out L, a, b: Extended);
begin
X := X / 95.047;
Y := Y / 100.000;
Z := Z / 108.883;
if ( X > 0.008856 ) then
X := Power(X, 1.0/3.0)
else
X := ( 7.787 * X ) + ( 16.0 / 116.0 );
if ( Y > 0.008856 ) then
Y := Power(Y, 1.0/3.0)
else
Y := ( 7.787 * Y ) + ( 16.0 / 116.0 );
if ( Z > 0.008856 ) then
Z := Power(Z, 1.0/3.0)
else
Z := ( 7.787 * Z ) + ( 16.0 / 116.0 );
L := (116.0 * Y ) - 16.0;
a := 500.0 * ( X - Y );
b := 200.0 * ( Y - Z );
end;
procedure CIELabtoXYZ(L, a, b: Extended; out X, Y, Z: Extended);
begin
Y := ( L + 16 ) / 116.0;
X := ( a / 500.0 )+ Y;
Z := Y - ( b / 200.0 );
if ( Power(Y, 3) > 0.008856 ) then
Y := Power(Y, 3)
else
Y := ( Y - (16.0 / 116.0 )) / 7.787;
if ( Power(X, 3) > 0.008856 ) then
X := Power(X, 3)
else
X := ( X - (16.0 / 116.0) ) / 7.787;
if ( Power(Z, 3) > 0.008856 ) then
Z := Power(Z, 3)
else
Z := ( Z - (16.0 / 116.0) ) / 7.787;
X := 95.047 * X;
Y := 100.000 * Y;
Z := 108.883 * Z;
end;
end.