mirror of
https://github.com/moparisthebest/Simba
synced 2024-08-13 16:53:59 -04:00
Added several bitmap functions (Contrast, Brightness, Invert, Desaturate)
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@133 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond
parent
4a65a1ffb1
commit
030aac3748
@ -186,3 +186,44 @@ begin;
|
||||
Bmp[Bitmap].RotateBitmap(angle,Bmp[result]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function Desaturate(Bitmap : integer) : integer;
|
||||
begin;
|
||||
with CurrThread.Client.MBitmaps do
|
||||
begin;
|
||||
result := CreateBMP(0,0);
|
||||
Bmp[Bitmap].Desaturate(Bmp[result]);
|
||||
end;
|
||||
end;
|
||||
procedure InvertBitmap(Bitmap : integer);
|
||||
begin;
|
||||
CurrThread.Client.MBitmaps.Bmp[Bitmap].Invert;
|
||||
end;
|
||||
function CopyBitmap(Bitmap : integer) : integer;
|
||||
begin;
|
||||
result := Currthread.Client.MBitmaps.CopyBMP(bitmap);
|
||||
end;
|
||||
function GreyScaleBitmap(Bitmap : integer) : integer;
|
||||
begin;
|
||||
with CurrThread.Client.MBitmaps do
|
||||
begin;
|
||||
result := CreateBMP(0,0);
|
||||
Bmp[Bitmap].GreyScale(Bmp[result]);
|
||||
end;
|
||||
end;
|
||||
function BrightnessBitmap(Bitmap,br : integer) : integer;
|
||||
begin;
|
||||
with CurrThread.Client.MBitmaps do
|
||||
begin;
|
||||
result := CreateBMP(0,0);
|
||||
Bmp[Bitmap].Brightness(Bmp[result],br);
|
||||
end;
|
||||
end;
|
||||
function ContrastBitmap(bitmap : integer; co : extended) : integer;
|
||||
begin;
|
||||
with CurrThread.Client.MBitmaps do
|
||||
begin;
|
||||
result := CreateBMP(0,0);
|
||||
Bmp[Bitmap].Contrast(Bmp[result],co);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -106,4 +106,10 @@ Sender.AddFunction(@FindBitmapSpiral,'function FindBitmapSpiral(bitmap: Integer;
|
||||
Sender.AddFunction(@FindBitmapsSpiralTolerance,'function FindBitmapsSpiralTolerance(bitmap: integer; x, y: Integer; var Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;');
|
||||
Sender.AddFunction(@FindBitmapSpiralTolerance,'function FindBitmapSpiralTolerance(bitmap: integer; var x, y: Integer; xs, ys, xe, ye,tolerance : integer): Boolean;');
|
||||
Sender.AddFunction(@RotateBitmap,'function RotateBitmap(bitmap: Integer; angle: Extended): Integer;');
|
||||
Sender.AddFunction(@Desaturate,'function DesaturateBitmap(Bitmap : integer) : integer;');
|
||||
sender.AddFunction(@InvertBitmap,'procedure InvertBitmap(Bitmap : integer);');
|
||||
Sender.AddFunction(@CopyBitmap,'function CopyBitmap(Bitmap: integer) : integer)');
|
||||
Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) : integer');
|
||||
Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;');
|
||||
Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;');
|
||||
|
||||
|
||||
@ -60,6 +60,15 @@ type
|
||||
procedure FastReplaceColor(OldColor, NewColor: TColor);
|
||||
procedure CopyClientToBitmap(MWindow : TMWindow; xs, ys, xe, ye: Integer);
|
||||
procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );
|
||||
procedure Desaturate;overload;
|
||||
procedure Desaturate(TargetBitmap : TMufasaBitmap); overload;
|
||||
procedure GreyScale(TargetBitmap : TMufasaBitmap);overload;
|
||||
procedure GreyScale;
|
||||
procedure Brightness(br: integer);overload;
|
||||
procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer); overload;
|
||||
procedure Contrast(co: Extended);overload;
|
||||
procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);overload;
|
||||
procedure Invert;
|
||||
constructor Create;
|
||||
destructor Destroy;override;
|
||||
end;
|
||||
@ -76,6 +85,7 @@ type
|
||||
function GetBMP(Index : integer) : TMufasaBitmap;
|
||||
property Bmp[Index : integer]: TMufasaBitmap read GetBMP;
|
||||
function CreateBMP(w, h: integer): Integer;
|
||||
function CopyBMP( Bitmap : integer) : Integer;
|
||||
function CreateMirroredBitmap(bitmap: Integer; MirrorStyle : TBmpMirrorStyle): Integer;
|
||||
function CreateBMPFromFile(const Path : string) : integer;
|
||||
function CreateBMPFromString(width,height : integer; Data : string) : integer;overload;
|
||||
@ -89,7 +99,8 @@ type
|
||||
implementation
|
||||
|
||||
uses
|
||||
Windowutil,paszlib,DCPbase64,mmath,math;
|
||||
Windowutil,paszlib,DCPbase64,mmath,math,
|
||||
colour_conv;
|
||||
|
||||
function Min(a,b:integer) : integer;
|
||||
begin
|
||||
@ -134,6 +145,17 @@ begin
|
||||
BmpArray[Result].Index:= Result;
|
||||
end;
|
||||
|
||||
function TMBitmaps.CopyBMP(Bitmap: integer): Integer;
|
||||
var
|
||||
InputBMP : TMufasaBitmap;
|
||||
OutputBMP : TMUfasaBitmap;
|
||||
begin
|
||||
InputBMP := GetBMP(Bitmap);
|
||||
Result := CreateBMP(InputBmp.w,InputBMP.h);
|
||||
OutputBMP := GetBMP(Result);
|
||||
Move(InputBMP.FData[0],OutPutBMP.FData[0],InputBMP.w * InputBMP.h * SizeOf(TRGB32));
|
||||
end;
|
||||
|
||||
function TMBitmaps.CreateMirroredBitmap(bitmap: Integer;
|
||||
MirrorStyle: TBmpMirrorStyle): Integer;
|
||||
var
|
||||
@ -516,11 +538,181 @@ begin
|
||||
if not ((Oldx <0) or (Oldx >= w) or (Oldy < 0) or (Oldy >= h)) then
|
||||
TargetBitmap.FData[ y * NewW + x] := Self.FData[OldY * W + OldX];
|
||||
end;
|
||||
end;
|
||||
|
||||
//NewX = Round(MiddlePoint.x + CosAngle * (x-MiddlePoint.x) - SinAngle * (y-MiddlePoint.y)) - MinX;
|
||||
//NewY = Round(MiddlePoint.y + SinAngle * (x-MiddlePoint.x) + CosAngle * (y-MiddlePoint.y)) - MinY;
|
||||
// Writeln(Format('(%d,%d) becomes (%d,%d)',[x,y,Round(MiddlePoint.x + CosAngle * (x-MiddlePoint.x) - SinAngle * (y-MiddlePoint.y)) - MinX,
|
||||
// Round(MiddlePoint.y + SinAngle * (x-MiddlePoint.x) + CosAngle * (y-MiddlePoint.y))]));
|
||||
procedure TMufasaBitmap.Desaturate;
|
||||
var
|
||||
I : integer;
|
||||
He,Se,Le : extended;
|
||||
Ptr : PRGB32;
|
||||
begin
|
||||
Ptr := FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
RGBToHSL(Ptr^.R,Ptr^.G,Ptr^.B,He,Se,Le);
|
||||
HSLtoRGB(He,0.0,Le,Ptr^.R,Ptr^.G,Ptr^.B);
|
||||
inc(ptr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.Desaturate(TargetBitmap: TMufasaBitmap);
|
||||
var
|
||||
I : integer;
|
||||
He,Se,Le : extended;
|
||||
PtrOld,PtrNew : PRGB32;
|
||||
begin
|
||||
TargetBitmap.SetSize(w,h);
|
||||
PtrOld := Self.FData;
|
||||
PtrNew := TargetBitmap.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
RGBToHSL(PtrOld^.R,PtrOld^.G,PtrOld^.B,He,Se,Le);
|
||||
HSLtoRGB(He,0.0,Le,PtrNew^.R,PtrNew^.G,PtrNew^.B);
|
||||
inc(ptrOld);
|
||||
inc(PtrNew);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.GreyScale(TargetBitmap: TMufasaBitmap);
|
||||
var
|
||||
I : integer;
|
||||
Lum : byte;
|
||||
PtrOld,PtrNew : PRGB32;
|
||||
begin
|
||||
TargetBitmap.SetSize(w,h);
|
||||
PtrOld := Self.FData;
|
||||
PtrNew := TargetBitmap.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
Lum := Round(PtrOld^.r * 0.3 + PtrOld^.g * 0.59 + PtrOld^.b * 0.11);
|
||||
PtrNew^.r := Lum;
|
||||
PtrNew^.g := Lum;
|
||||
PtrNew^.b := Lum;
|
||||
inc(ptrOld);
|
||||
inc(PtrNew);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.GreyScale;
|
||||
var
|
||||
I : integer;
|
||||
Lum : Byte;
|
||||
Ptr: PRGB32;
|
||||
begin
|
||||
Ptr := Self.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
Lum := Round(Ptr^.r * 0.3 + Ptr^.g * 0.59 + Ptr^.b * 0.11);
|
||||
Ptr^.r := Lum;
|
||||
Ptr^.g := Lum;
|
||||
Ptr^.b := Lum;
|
||||
inc(ptr);
|
||||
end;
|
||||
end;
|
||||
|
||||
function BrigthnessAdjust(Col: byte; br : integer): byte;inline;
|
||||
var
|
||||
temp : integer;
|
||||
begin;
|
||||
Temp := Col + Br;
|
||||
if temp < 0 then
|
||||
temp := 0
|
||||
else if temp > 255 then
|
||||
temp := 255;
|
||||
result := temp;
|
||||
end;
|
||||
procedure TMufasaBitmap.Brightness(br: integer);
|
||||
var
|
||||
I : integer;
|
||||
Ptr: PRGB32;
|
||||
begin
|
||||
Ptr := Self.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
Ptr^.r := BrigthnessAdjust(Ptr^.r,br);
|
||||
Ptr^.g := BrigthnessAdjust(Ptr^.g,br);
|
||||
Ptr^.b := BrigthnessAdjust(Ptr^.b,br);
|
||||
inc(ptr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.Brightness(TargetBitmap: TMufasaBitmap; br: integer);
|
||||
var
|
||||
I : integer;
|
||||
PtrOld,PtrNew : PRGB32;
|
||||
begin
|
||||
TargetBitmap.SetSize(w,h);
|
||||
PtrOld := Self.FData;
|
||||
PtrNew := TargetBitmap.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
PtrNew^.r := BrigthnessAdjust(PtrOld^.r,br);
|
||||
PtrNew^.g := BrigthnessAdjust(PtrOld^.g,br);
|
||||
PtrNew^.b := BrigthnessAdjust(PtrOld^.b,br);
|
||||
inc(ptrOld);
|
||||
inc(PtrNew);
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
Grey = 128;
|
||||
function ContrastAdjust(Col: byte; co : extended): byte;inline;
|
||||
var
|
||||
temp : integer;
|
||||
begin;
|
||||
Temp := floor((col - Grey) * co) + grey;
|
||||
if temp < 0 then
|
||||
temp := 0
|
||||
else if temp > 255 then
|
||||
temp := 255;
|
||||
result := temp;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.Contrast(co: Extended);
|
||||
var
|
||||
I : integer;
|
||||
Ptr: PRGB32;
|
||||
begin
|
||||
Ptr := Self.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
Ptr^.r := ContrastAdjust(Ptr^.r,co);
|
||||
Ptr^.g := ContrastAdjust(Ptr^.g,co);
|
||||
Ptr^.b := ContrastAdjust(Ptr^.b,co);
|
||||
inc(ptr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.Contrast(TargetBitmap: TMufasaBitmap; co: Extended);
|
||||
var
|
||||
I : integer;
|
||||
PtrOld,PtrNew : PRGB32;
|
||||
begin
|
||||
TargetBitmap.SetSize(w,h);
|
||||
PtrOld := Self.FData;
|
||||
PtrNew := TargetBitmap.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
PtrNew^.r := ContrastAdjust(PtrOld^.r,co);
|
||||
PtrNew^.g := ContrastAdjust(PtrOld^.g,co);
|
||||
PtrNew^.b := ContrastAdjust(PtrOld^.b,co);
|
||||
inc(ptrOld);
|
||||
inc(PtrNew);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMufasaBitmap.Invert;
|
||||
var
|
||||
Ptr : PRGB32;
|
||||
i : integer;
|
||||
begin
|
||||
ptr := Self.FData;
|
||||
for i := (h*w-1) downto 0 do
|
||||
begin;
|
||||
Self.FData[i].r := not Self.FData[i].r;
|
||||
Self.FData[i].g := not Self.FData[i].g;
|
||||
Self.Fdata[i].b := not Self.FData[i].b;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TMBitmaps.Create(Owner: TObject);
|
||||
|
||||
@ -1,260 +1,304 @@
|
||||
{
|
||||
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+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Graphics,
|
||||
Math;
|
||||
|
||||
|
||||
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
|
||||
Function RGBtoColor(r,g,b : integer) : TColor; overload; inline;
|
||||
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
|
||||
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
|
||||
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
|
||||
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
|
||||
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
|
||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;
|
||||
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
OneDivThree = 1/3.0;
|
||||
TwoDivThree = 2 / 3.0;
|
||||
OneDivTwoPointFour = 1 / 2.4;
|
||||
|
||||
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;var 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;var 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 : integer;var 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
|
||||
Red := Red / 7.73994;
|
||||
if Green > 0.04045 then
|
||||
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
|
||||
else
|
||||
Green := Green / 7.73994;
|
||||
if Blue > 0.04045 then
|
||||
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
|
||||
else
|
||||
Blue := Blue / 7.73994;
|
||||
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;var R,G,B: integer); 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 : integer;var 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 H (Hue), S (Saturation) and L (Luminance) components to
|
||||
Red (R), Green (G) and Blue (B) components.
|
||||
/\}
|
||||
|
||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); 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 := 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; var h, s, l: Extended); inline;
|
||||
Var
|
||||
R, G, B: Integer;
|
||||
Begin
|
||||
ColorToRGB(Col, R, G, B);
|
||||
RGBToHSL(R, G, B, H, S, L);
|
||||
End;
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
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+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
Graphics,
|
||||
Math;
|
||||
|
||||
|
||||
Function RGBtoColor(r,g,b : byte) : TColor; overload; inline;
|
||||
Function RGBtoColor(r,g,b : integer) : TColor; overload; inline;
|
||||
Procedure ColorToRGB(Color : integer;var r,g,b : byte); overload; inline;
|
||||
Procedure ColorToRGB(Color : integer;var r,g,b : integer); overload; inline;
|
||||
Procedure RGBToXYZ(R,G,B : integer;var x,y,z : Extended); inline;
|
||||
Procedure XYZToRGB(X,Y,Z : Extended;var R,G,B: integer); inline;
|
||||
Procedure RGBToHSL(RR,GG,BB : integer;var H,S,L : Extended); inline;
|
||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Byte); inline;overload;
|
||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); inline;overload;
|
||||
Procedure ColorToHSL(Col: Integer; var h, s, l: Extended); inline;
|
||||
|
||||
implementation
|
||||
|
||||
Const
|
||||
OneDivThree = 1/3.0;
|
||||
TwoDivThree = 2 / 3.0;
|
||||
OneDivTwoPointFour = 1 / 2.4;
|
||||
|
||||
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;var 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;var 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 : integer;var 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
|
||||
Red := Red / 7.73994;
|
||||
if Green > 0.04045 then
|
||||
Green := Power( ( Green + 0.055 ) / 1.055 , 2.4) * 100
|
||||
else
|
||||
Green := Green / 7.73994;
|
||||
if Blue > 0.04045 then
|
||||
Blue := Power( ( Blue + 0.055 ) / 1.055 , 2.4) * 100
|
||||
else
|
||||
Blue := Blue / 7.73994;
|
||||
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;var R,G,B: integer); 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 : integer;var 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 H (Hue), S (Saturation) and L (Luminance) components to
|
||||
Red (R), Green (G) and Blue (B) components.
|
||||
/\}
|
||||
|
||||
procedure HSLtoRGB(H, S, L: extended; var R, G, B: Byte); inline; overload;
|
||||
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;
|
||||
|
||||
Procedure HSLtoRGB(H,S,L : extended;var R,G,B : Integer); 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 := 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; var h, s, l: Extended); inline;
|
||||
Var
|
||||
R, G, B: Integer;
|
||||
Begin
|
||||
ColorToRGB(Col, R, G, B);
|
||||
RGBToHSL(R, G, B, H, S, L);
|
||||
End;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user