求： CIE LAB色系 转换给 RGB或TColor的算法/函数(200分)

明白的就回答，不明白的是路过。

目的，让数据可视化。

这个帖子的转换算法比较全，看看吧 []
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1093303

都试过，差的太远啦，简直不敢相信

我记得 GraphicEx 源码里有
因为 GraphicEx要打开PhotoShop的文件
下面是 GraphicEx 的一个源码
unit GraphicColor;

// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in compliance
// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
// Software distributed under the License is distributed on an "AS IS" basis,
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
// specific language governing rights and limitations under the License.
//
// The original code is GraphicColor.pas, released November 1, 1999.
//
// The initial developer of the original code is Dipl. Ing. Mike Lischke (Plei遖, Germany, www.delphi-gems.com),
//
// Portions created by Dipl. Ing. Mike Lischke are Copyright
// (C) 1999-2003 Dipl. Ing. Mike Lischke. All Rights Reserved.
//----------------------------------------------------------------------------------------------------------------------
// This file is part of the image library GraphicEx.
//
// GraphicColor contains the implementation of the color conversion manager.
// This class is responsible for converting between these color schemes/formats:
// - RGB(A)
// - BGR(A)
// - CMY(K)
// - CIE L*a*b*
// - PhotoYCC, standard YCbCr
// - indexed
// - grayscale (with alpha, which is ignored currently)
//
// Additional tasks are:
// - coversions between bit depths (1, 2, 4, 8, 16 bits)
// - palette creation
// - gamma tables creation and application
// - masked pixel transfer for interlaced images
// - big endian swap
// - plane (planar) -> interleaved (interlaced) conversion
//
// Notes:
// - Throughout the entire unit I used the terms BPS and SPP for "bits per sample" and
// "samples per pixel", respectively. A sample is one component per pixel. For indexed color schemes
// there's only 1 sample per pixel, for RGB there are 3 (red, green and blue) and so on.
// - The bit depth of multi sample formats like RGB must be equal for each color component.
// - Because of the large amount of possible combinations (color schemes, sample depth, gamma, byte swap)
// I limited the accepted combinations to pratical ones. This leaves currently out:
// + gamma correction for 16 bit values
// + conversion to 16 bit (target) grayscale with alpha
// + samples sizes less than 8 bits for multi-sample schemes (RGB etc.)
// + indexed schemes with planes (e.g. 16 colors indexed as 4 planes each with one bit per sample)
// - For now there is no conversion between indexed and non-indexed formats. Also between grayscale
// and any other scheme is no conversion possible.
//
//----------------------------------------------------------------------------------------------------------------------

interface

{$I GraphicConfiguration.inc}

uses
Windows, Graphics, GraphicStrings;

const
// this is the value for average CRT monitors, adjust it if your monitor differs
DefaultDisplayGamma = 2.2;

type
TColorScheme = (
csUnknown, // not (yet) defined color scheme
csIndexed, // any palette format
csG, // gray scale
csGA, // gray scale with alpha channel
csRGB, // red, green, blue
csRGBA, // RGB with alpha channel
csBGR, // RGB in reversed order (used under Windows)
csBGRA, // BGR with alpha channel (alpha is always the last component)
csCMY, // cyan, magenta, yellow (used mainly for printing processes)
csCMYK, // CMY with black
csCIELab, // CIE color format using luminance and chromaticities
csYCbCr, // another format using luminance and chromaticities
csPhotoYCC // a modified YCbCr version used for photo CDs
);

TConvertOptions = set of (
coAlpha, // alpha channel is to be considered (this value is usually automatically set depending on
// the color scheme)
coApplyGamma, // target only, gamma correction must take place
coNeedByteSwap, // endian switch needed
coLabByteRange, // CIE L*a*b* only, luminance range is from 0..255 instead 0..100
coLabChromaOffset // CIE L*a*b* only, chrominance values a and b are given in 0..255 instead -128..127
);

// format of the raw data to create a color palette from
TRawPaletteFormat = (
pfInterlaced8Triple, // rgb triple with 8 bits per component
pfInterlaced8Quad, // rgb quad with 8 bits per component (fourth entry is reserved as in Windows' logical palette)
pfPlane8Triple, // 3 separate planes of data with 8 bits per component
pfPlane8Quad,
pfInterlaced16Triple,// rgb triple with 16 bits per component
pfInterlaced16Quad,
pfPlane16Triple, // 3 separate planes of data with 16 bits per component
pfPlane16Quad
);

// TConversionMethod describes the general parameter list to which each implemented conversion method conforms.
// Note: Source is defined as open array parameter to allow plane and interlaced source data.
TConversionMethod = procedure(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte) of object;

TColorManager = class
private
FChanged: Boolean; // set if any of the parameters changed
FSourceBPS, // bits per sample of source data (allowed values are 1, 2, 4, 8, 16)
FTargetBPS, // bits per sample of target data (allowed values are 1, 2, 4, 8, 16)
FSourceSPP, // samples per source pixel (allowed values are 1, 3, 4)
FTargetSPP: Byte; // samples per target pixel (allowed values are 1, 3, 4)
FMainGamma, // primary gamma value which is usually read from a file (default is 1)
FDisplayGamma: Single; // (constant) gamma value of the current monitor (default is 2.2)
FGammaTable: array[Byte] of Byte; // contains precalculated gamma values for each possible component value
// (range is 0..255)
FYCbCrCoefficients: array[0..2] of Single;
FHSubsampling,
FVSubSampling: Byte; // additional parameters used for YCbCr conversion
FCrToRedTable, // lookup tables used for YCbCr conversion
FCbToBlueTable,
FCrToGreenTable,
FCbToGreenTable: array of Integer;

FSourceScheme,
FTargetScheme: TColorScheme;
FRowConversion: TConversionMethod; // procedure variable for the actual conversion method used
FSourceOptions,
FTargetOptions: TConvertOptions; // options to control conversion
protected
// Low level conversion helper used to convert one pixel component.
function ComponentGammaConvert(Value: Byte): Byte;
function ComponentNoConvert16(Value: Word): Word;
function ComponentNoConvert8(Value: Byte): Byte;
function ComponentScaleConvert(Value: Word): Byte;
function ComponentScaleGammaConvert(Value: Word): Byte;
function ComponentSwapScaleGammaConvert(Value: Word): Byte;
function ComponentSwapScaleConvert(Value: Word): Byte;
function ComponentSwapConvert(Value: Word): Word;

// row conversion routines
procedure RowConvertBGR2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertBGR2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertCIELAB2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertCIELAB2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertCMYK2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertCMYK2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertGray(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertIndexed8(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertIndexedBoth16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertIndexedSource16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertIndexedTarget16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertRGB2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertRGB2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertPhotoYCC2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertPhotoYCC2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertYCbCr2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
procedure RowConvertYCbCr2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// other general routines
procedure CreateYCbCrLookup;
function GetPixelFormat(Index: Integer): TPixelFormat;
procedure PrepareConversion;
procedure SetSourceBitsPerSample(const Value: Byte);
procedure SetSourceColorScheme(const Value: TColorScheme);
procedure SetSourceSamplesPerPixel(const Value: Byte);
procedure SetTargetBitsPerSample(const Value: Byte);
procedure SetTargetColorScheme(const Value: TColorScheme);
procedure SetTargetSamplesPerPixel(const Value: Byte);
public
constructor Create;

procedure ConvertRow(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);
function CreateColorPalette(Data: array of Pointer; DataFormat: TRawPaletteFormat; ColorCount: Cardinal;
RGB: Boolean): HPALETTE;
function CreateGrayscalePalette(MinimumIsWhite: Boolean): HPALETTE;
procedure Error(const Msg: String);
procedure SetGamma(MainGamma: Single; DisplayGamma: Single = DefaultDisplayGamma);
procedure SetYCbCrParameters(Values: array of Single; HSubSampling, VSubSampling: Byte);

property SourceBitsPerSample: Byte read FSourceBPS write SetSourceBitsPerSample;
property SourceColorScheme: TColorScheme read FSourceScheme write SetSourceColorScheme;
property SourceOptions: TConvertOptions read FSourceOptions write FSourceOptions;
property SourcePixelFormat: TPixelFormat index 0 read GetPixelFormat;
property SourceSamplesPerPixel: Byte read FSourceSPP write SetSourceSamplesPerPixel;
property TargetBitsPerSample: Byte read FTargetBPS write SetTargetBitsPerSample;
property TargetColorScheme: TColorScheme read FTargetScheme write SetTargetColorScheme;
property TargetOptions: TConvertOptions read FTargetOptions write FTargetOptions;
property TargetPixelFormat: TPixelFormat index 1 read GetPixelFormat;
property TargetSamplesPerPixel: Byte read FTargetSPP write SetTargetSamplesPerPixel;
end;

function ClampByte(Value: Integer): Byte;
function MulDiv16(Number, Numerator, Denominator: Word): Word;

//----------------------------------------------------------------------------------------------------------------------

implementation

uses
Math, SysUtils;

type
EColorConversionError = class(Exception);

PCMYK = ^TCMYK;
TCMYK = packed record
C, M, Y, K: Byte;
end;

PCMYK16 = ^TCMYK16;
TCMYK16 = packed record
C, M, Y, K: Word;
end;

PCMY = ^TCMY;
TCMY = packed record
C, M, Y: Byte;
end;

PCMY16 = ^TCMY16;
TCMY16 = packed record
C, M, Y: Word;
end;

PRGB = ^TRGB;
TRGB = packed record
R, G, B: Byte;
end;

PRGB16 = ^TRGB16;
TRGB16 = packed record
R, G, B: Word;
end;

PRGBA = ^TRGBA;
TRGBA = packed record
R, G, B, A: Byte;
end;

PRGBA16 = ^TRGBA16;
TRGBA16 = packed record
R, G, B, A: Word;
end;

PBGR = ^TBGR;
TBGR = packed record
B, G, R: Byte;
end;

PBGR16 = ^TBGR16;
TBGR16 = packed record
B, G, R: Word;
end;

PBGRA = ^TBGRA;
TBGRA = packed record
B, G, R, A: Byte;
end;

PBGRA16 = ^TBGRA16;
TBGRA16 = packed record
B, G, R, A: Word;
end;

//----------------- helper functions -----------------------------------------------------------------------------------

function ClampByte(Value: Integer): Byte;

// ensures Value is in the range 0..255, values < 0 are clamped to 0 and values > 255 are clamped to 255

asm
OR EAX, EAX
JNS @@positive
XOR EAX, EAX
RET

@@positive:
CMP EAX, 255
JBE @@OK
MOV EAX, 255
@@OK:
end;

//----------------------------------------------------------------------------------------------------------------------

function MulDiv16(Number, Numerator, Denominator: Word): Word;

// faster equivalent to Windows' MulDiv function
// Number is passed via AX
// Numerator is passed via DX
// Denominator is passed via CX
// Result is passed via AX
// Note: No error checking takes place. Denominator must be > 0!

asm
MUL DX
DIV CX
end;

//----------------- TColorManager --------------------------------------------------------------------------------------

constructor TColorManager.Create;

// set some default values

begin
FSourceBPS := 8;
FTargetBPS := 8;
FSourceSPP := 3; // 24 bit format
FTargetSPP := 3; // 24 bit format
SetGamma(1, DefaultDisplayGamma);
FSourceScheme := csRGB;
FTargetScheme := csBGR;

// defaults are from CCIR Recommendation 601-1
FYCbCrCoefficients[0] := 0.299;
FYCbCrCoefficients[1] := 0.587;
FYCbCrCoefficients[2] := 0.114;

FHSubSampling := 1;
FVSubSampling := 1;

FChanged := True;
end;

//----------------- low level conversion routines ----------------------------------------------------------------------

// These routines are used for conversions from 16 to 8 bit values, either with gamma correction or byte swap (or both).

function TColorManager.ComponentNoConvert8(Value: Byte): Byte;

begin
Result := Value;
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentNoConvert16(Value: Word): Word;

begin
Result := Value;
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentGammaConvert(Value: Byte): Byte;

begin
Result := FGammaTable[Value];
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentScaleConvert(Value: Word): Byte;

begin
Result := MulDiv16(Value, 255, 65535);
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentScaleGammaConvert(Value: Word): Byte;

begin
Result := FGammaTable[MulDiv16(Value, 255, 65535)];
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentSwapScaleGammaConvert(Value: Word): Byte;

begin
Result := FGammaTable[MulDiv16(Swap(Value), 255, 65535)];
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentSwapScaleConvert(Value: Word): Byte;

begin
Result := MulDiv16(Swap(Value), 255, 65535);
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.ComponentSwapConvert(Value: Word): Word;

begin
Result := Swap(Value);
end;

//----------------- row conversion routines ----------------------------------------------------------------------------

// Notes: Each method takes parameters for source and target data as well as the count of pixels to work on. This count
// determines the number of pixels in the target buffer. The actual source count may differ for special color
// schemes (like YCbCr) or interlaced lines.
// Mask is a parameter which determines (in a repeative manner) which source pixel should actually be transferred
// to the target buffer. A 1 in the corresponding bit (MSB is leftmost pixel) causes the transfer to happen.
// Usually, this parameter is $FF to transfer all pixels, but for interlaced images (e.g. as in PNG format)
// this will differ to limit pixel transfers. The bit mask only describes which target pixel is to skip. Source
// pixel must be packed.
// Windows DIBs are always byte aligned, so we don't need checks for byte alignments (in target).

procedure TColorManager.RowConvertBGR2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// same as ConvertBGR2RGB but for BGR target schemes

var
SourceR16,
SourceG16,
SourceB16,
SourceA16: PWord;

SourceR8,
SourceG8,
SourceB8,
SourceA8: PByte;

TargetRun16: PBGR16;
TargetRunA16: PBGRA16;
TargetRun8: PBGR;
TargetRunA8: PBGRA;
BitRun: Byte;

Convert8_8: function(Value: Byte): Byte of object;
Convert16_8: function(Value: Word): Byte of object;
Convert16_8Alpha: function(Value: Word): Byte of object;
Convert16_16: function(Value: Word): Word of object;

SourceIncrement,
TargetIncrement: Cardinal;
CopyAlpha: Boolean;

begin
BitRun := $80;
// determine alpha handling once
CopyAlpha := False;
if coAlpha in FSourceOptions then
begin
SourceIncrement := SizeOf(TRGBA);
TargetIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then CopyAlpha := True;
end
else
begin
SourceIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then TargetIncrement := SizeOf(TRGBA)
else TargetIncrement := SizeOf(TRGB);
end;
// in planar mode source increment is always 1
if Length(Source) > 1 then SourceIncrement := 1;

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
// interleaved mode
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

case FTargetBPS of
8: // 888 to 888
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert8_8(SourceR8^);
TargetRunA8.G := Convert8_8(SourceG8^);
TargetRunA8.B := Convert8_8(SourceB8^);
// alpha values are never gamma corrected
TargetRunA8.A := SourceA8^;

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert8_8(SourceR8^);
TargetRun8.G := Convert8_8(SourceG8^);
TargetRun8.B := Convert8_8(SourceB8^);

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 888 to 161616
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;
if Length(Source) = 1 then
begin
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRunA16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRunA16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));
TargetRunA16.A := Convert16_16(MulDiv16(SourceA8^, 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRun16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRun16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

case FTargetBPS of
8: // 161616 to 888
begin
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleGammaConvert
else Convert16_8 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleConvert
else Convert16_8 := ComponentScaleConvert;
end;
// since alpha channels are never gamma corrected we need a separate conversion routine
if coNeedByteSwap in FSourceOptions then Convert16_8Alpha := ComponentSwapScaleConvert
else Convert16_8Alpha := ComponentScaleConvert;

if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert16_8(SourceR16^);
TargetRunA8.G := Convert16_8(SourceG16^);
TargetRunA8.B := Convert16_8(SourceB16^);
TargetRunA8.A := Convert16_8Alpha(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert16_8(SourceR16^);
TargetRun8.G := Convert16_8(SourceG16^);
TargetRun8.B := Convert16_8(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 161616 to 161616
begin
// no gamma correction for 16 bit samples yet
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;

if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(SourceR16^);
TargetRunA16.G := Convert16_16(SourceG16^);
TargetRunA16.B := Convert16_16(SourceB16^);
TargetRunA16.A := Convert16_16(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(SourceR16^);
TargetRun16.G := Convert16_16(SourceG16^);
TargetRun16.B := Convert16_16(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertBGR2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// Converts BGR source schemes to RGB target schemes and takes care for byte swapping, alpha copy/skip and
// gamma correction.

var
SourceR16,
SourceG16,
SourceB16,
SourceA16: PWord;

SourceR8,
SourceG8,
SourceB8,
SourceA8: PByte;

TargetRun16: PRGB16;
TargetRunA16: PRGBA16;
TargetRun8: PRGB;
TargetRunA8: PRGBA;
BitRun: Byte;

Convert8_8: function(Value: Byte): Byte of object;
Convert16_8: function(Value: Word): Byte of object;
Convert16_8Alpha: function(Value: Word): Byte of object;
Convert16_16: function(Value: Word): Word of object;

SourceIncrement,
TargetIncrement: Cardinal;
CopyAlpha: Boolean;

begin
BitRun := $80;
// determine alpha handling once
CopyAlpha := False;
if coAlpha in FSourceOptions then
begin
SourceIncrement := SizeOf(TRGBA);
TargetIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then CopyAlpha := True;
end
else
begin
SourceIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then TargetIncrement := SizeOf(TRGBA)
else TargetIncrement := SizeOf(TRGB);
end;
// in planar mode source increment is always 1
if Length(Source) > 1 then SourceIncrement := 1;

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
// interleaved mode
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

case FTargetBPS of
8: // 888 to 888
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert8_8(SourceR8^);
TargetRunA8.G := Convert8_8(SourceG8^);
TargetRunA8.B := Convert8_8(SourceB8^);
// alpha values are never gamma corrected
TargetRunA8.A := SourceA8^;

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert8_8(SourceR8^);
TargetRun8.G := Convert8_8(SourceG8^);
TargetRun8.B := Convert8_8(SourceB8^);

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 888 to 161616
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;
if Length(Source) = 1 then
begin
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRunA16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRunA16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));
TargetRunA16.A := Convert16_16(MulDiv16(SourceA8^, 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRun16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRun16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

case FTargetBPS of
8: // 161616 to 888
begin
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleGammaConvert
else Convert16_8 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleConvert
else Convert16_8 := ComponentScaleConvert;
end;
// since alpha channels are never gamma corrected we need a separate conversion routine
if coNeedByteSwap in FSourceOptions then Convert16_8Alpha := ComponentSwapScaleConvert
else Convert16_8Alpha := ComponentScaleConvert;

if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert16_8(SourceR16^);
TargetRunA8.G := Convert16_8(SourceG16^);
TargetRunA8.B := Convert16_8(SourceB16^);
TargetRunA8.A := Convert16_8Alpha(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert16_8(SourceR16^);
TargetRun8.G := Convert16_8(SourceG16^);
TargetRun8.B := Convert16_8(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 161616 to 161616
begin
// no gamma correction for 16 bit samples yet
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;

if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(SourceR16^);
TargetRunA16.G := Convert16_16(SourceG16^);
TargetRunA16.B := Convert16_16(SourceB16^);
TargetRunA16.A := Convert16_16(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(SourceR16^);
TargetRun16.G := Convert16_16(SourceG16^);
TargetRun16.B := Convert16_16(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertCIELAB2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// conversion of the CIE L*a*b color space to BGR using a two way approach assuming a D65 white point,
// first a conversion to CIE XYZ is performed and then from there to RGB

var
LRun8,
aRun8,
bRun8: PByte;
LRun16,
aRun16,
bRun16: PWord;
L, a, b,
X, Y, Z, // color values in float format
T,
YYn3: Extended; // intermediate results
Target8: PByte;
Target16: PWord;
Increment: Integer;
AlphaSkip: Integer;
BitRun: Byte;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
LRun8 := Source[0];
aRun8 := LRun8; Inc(aRun8);
bRun8 := aRun8; Inc(bRun8);
Increment := 3;
end
else
begin
LRun8 := Source[0];
aRun8 := Source[1];
bRun8 := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: /// 888 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun8^ / 2.55
else L := LRun8^;
Inc(LRun8, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun8^ - 128;
Inc(aRun8, Increment);
b := bRun8^ - 128;
Inc(bRun8, Increment);
end
else
begin
a := ShortInt(aRun8^);
Inc(aRun8, Increment);
b := ShortInt(bRun8^);
Inc(bRun8, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this
// blue
Target8^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target8);
// green
Target8^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target8);
// red
Target8^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun8^ / 2.55
else L := LRun8^;
Inc(LRun8, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun8^ - 128;
Inc(aRun8, Increment);
b := bRun8^ - 128;
Inc(bRun8, Increment);
end
else
begin
a := ShortInt(aRun8^);
Inc(aRun8, Increment);
b := ShortInt(bRun8^);
Inc(bRun8, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// blue
Target16^ := MulDiv16(ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z))), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z))), 65535, 255);
Inc(Target16);
// red
Target16^ := MulDiv16(ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z))), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
LRun16 := Source[0];
aRun16 := LRun16; Inc(aRun16);
bRun16 := aRun16; Inc(bRun16);
Increment := 3;
end
else
begin
LRun16 := Source[0];
aRun16 := Source[1];
bRun16 := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun16^ / 2.55
else L := LRun16^;
Inc(LRun16, Increment);

if coLabChromaOffset in FSourceOptions then
begin
a := aRun16^ - 128;
Inc(aRun16, Increment);
b := bRun16^ - 128;
Inc(bRun16, Increment);
end
else
begin
a := ShortInt(aRun16^);
Inc(aRun16, Increment);
b := ShortInt(bRun16^);
Inc(bRun16, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// blue
Target8^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target8);
// green
Target8^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target8);
// red
Target8^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun16^ / 2.55
else L := LRun16^;
Inc(LRun16, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun16^ - 128;
Inc(aRun16, Increment);
b := bRun16^ - 128;
Inc(bRun16, Increment);
end
else
begin
a := ShortInt(aRun16^);
Inc(aRun16, Increment);
b := ShortInt(bRun16^);
Inc(bRun16, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// blue
Target16^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target16);
// green
Target16^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target16);
// red
Target16^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertCIELAB2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// just like RowConvertCIELAB2BGR but for RGB target schemes

var
LRun8,
aRun8,
bRun8: PByte;
LRun16,
aRun16,
bRun16: PWord;
L, a, b,
X, Y, Z, // color values in float format
T,
YYn3: Extended; // intermediate results
Target8: PByte;
Target16: PWord;
Increment: Integer;
AlphaSkip: Integer;
BitRun: Byte;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
LRun8 := Source[0];
aRun8 := LRun8; Inc(aRun8);
bRun8 := aRun8; Inc(bRun8);
Increment := 3;
end
else
begin
LRun8 := Source[0];
aRun8 := Source[1];
bRun8 := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: /// 888 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun8^ / 2.55
else L := LRun8^;
Inc(LRun8, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun8^ - 128;
Inc(aRun8, Increment);
b := bRun8^ - 128;
Inc(bRun8, Increment);
end
else
begin
a := ShortInt(aRun8^);
Inc(aRun8, Increment);
b := ShortInt(bRun8^);
Inc(bRun8, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// once we have CIE XYZ it is easy (yet quite expensive) to calculate RGB values from this
// red
Target8^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target8);
// green
Target8^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target8);
// blue
Target8^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun8^ / 2.55
else L := LRun8^;
Inc(LRun8, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun8^ - 128;
Inc(aRun8, Increment);
b := bRun8^ - 128;
Inc(bRun8, Increment);
end
else
begin
a := ShortInt(aRun8^);
Inc(aRun8, Increment);
b := ShortInt(bRun8^);
Inc(bRun8, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// red
Target16^ := MulDiv16(ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z))), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z))), 65535, 255);
Inc(Target16);
// blue
Target16^ := MulDiv16(ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z))), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
LRun16 := Source[0];
aRun16 := LRun16; Inc(aRun16);
bRun16 := aRun16; Inc(bRun16);
Increment := 3;
end
else
begin
LRun16 := Source[0];
aRun16 := Source[1];
bRun16 := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun16^ / 2.55
else L := LRun16^;
Inc(LRun16, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun16^ - 128;
Inc(aRun16, Increment);
b := bRun16^ - 128;
Inc(bRun16, Increment);
end
else
begin
a := ShortInt(aRun16^);
Inc(aRun16, Increment);
b := ShortInt(bRun16^);
Inc(bRun16, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// red
Target8^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target8);
// green
Target8^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target8);
// blue
Target8^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coLabByteRange in FSourceOptions then L := LRun16^ / 2.55
else L := LRun16^;
Inc(LRun16, Increment);
if coLabChromaOffset in FSourceOptions then
begin
a := aRun16^ - 128;
Inc(aRun16, Increment);
b := bRun16^ - 128;
Inc(bRun16, Increment);
end
else
begin
a := ShortInt(aRun16^);
Inc(aRun16, Increment);
b := ShortInt(bRun16^);
Inc(bRun16, Increment);
end;

YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;

// red
Target16^ := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
Inc(Target16);
// green
Target16^ := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
Inc(Target16);
// blue
Target16^ := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertCMYK2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts a stream of Count CMYK values to BGR

var
C8, M8, Y8, K8: PByte;
C16, M16, Y16, K16: PWord;
Target8: PByte;
Target16: PWord;
Increment: Integer;
AlphaSkip: Integer;
BitRun: Byte;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 4 then
begin
// plane mode
C8 := Source[0];
M8 := Source[1];
Y8 := Source[2];
K8 := Source[3];
Increment := 1;
end
else
begin
// interleaved mode
C8 := Source[0];
M8 := C8; Inc(M8);
Y8 := M8; Inc(Y8);
K8 := Y8; Inc(K8);
Increment := 4;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// blue
Target8^ := ClampByte(255 - (Y8^ - MulDiv16(Y8^, K8^, 255) + K8^));
Inc(Target8);
// green
Target8^ := ClampByte(255 - (M8^ - MulDiv16(M8^, K8^, 255) + K8^));
Inc(Target8);
// blue
Target8^ := ClampByte(255 - (C8^ - MulDiv16(C8^, K8^, 255) + K8^));
Inc(Target8, 1 + AlphaSkip);

Inc(C8, Increment);
Inc(M8, Increment);
Inc(Y8, Increment);
Inc(K8, Increment);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// blue
Target16^ := MulDiv16(ClampByte(255 - (Y8^ - MulDiv16(Y8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(255 - (M8^ - MulDiv16(M8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16);
// blue
Target16^ := MulDiv16(ClampByte(255 - (C8^ - MulDiv16(C8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16, 1 + AlphaSkip);

Inc(C8, Increment);
Inc(M8, Increment);
Inc(Y8, Increment);
Inc(K8, Increment);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 4 then
begin
// plane mode
C16 := Source[0];
M16 := Source[1];
Y16 := Source[2];
K16 := Source[3];
Increment := 1;
end
else
begin
// interleaved mode
C16 := Source[0];
M16 := C16; Inc(M16);
Y16 := M16; Inc(Y16);
K16 := Y16; Inc(K16);
Increment := 4;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// blue
Target8^ := ClampByte(255 - MulDiv16((Y16^ - MulDiv16(Y16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8);
// green
Target8^ := ClampByte(255 - MulDiv16((M16^ - MulDiv16(M16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8);
// blue
Target8^ := ClampByte(255 - MulDiv16((C16^ - MulDiv16(C16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8, 1 + AlphaSkip);

Inc(C16, Increment);
Inc(M16, Increment);
Inc(Y16, Increment);
Inc(K16, Increment);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// blue
Target16^ := 65535 - (Y16^ - MulDiv16(Y16^, K16^, 65535) + K16^);
Inc(Target16);
// green
Target16^ := 65535 - (M16^ - MulDiv16(M16^, K16^, 65535) + K16^);
Inc(Target16);
// blue
Target16^ := 65535 - (C16^ - MulDiv16(C16^, K16^, 65535) + K16^);
Inc(Target16, 1 + AlphaSkip);

Inc(C16, Increment);
Inc(M16, Increment);
Inc(Y16, Increment);
Inc(K16, Increment);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertCMYK2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts a stream of Count CMYK values to RGB,

var
C8, M8, Y8, K8: PByte;
C16, M16, Y16, K16: PWord;
Target8: PByte;
Target16: PWord;
Increment: Integer;
AlphaSkip: Integer;
BitRun: Byte;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 4 then
begin
// plane mode
C8 := Source[0];
M8 := Source[1];
Y8 := Source[2];
K8 := Source[3];
Increment := 1;
end
else
begin
// interleaved mode
C8 := Source[0];
M8 := C8; Inc(M8);
Y8 := M8; Inc(Y8);
K8 := Y8; Inc(K8);
Increment := 4;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// red
Target8^ := ClampByte(255 - (C8^ - MulDiv16(C8^, K8^, 255) + K8^));
Inc(Target8);
// green
Target8^ := ClampByte(255 - (M8^ - MulDiv16(M8^, K8^, 255) + K8^));
Inc(Target8);
// blue
Target8^ := ClampByte(255 - (Y8^ - MulDiv16(Y8^, K8^, 255) + K8^));
Inc(Target8, 1 + AlphaSkip);

Inc(C8, Increment);
Inc(M8, Increment);
Inc(Y8, Increment);
Inc(K8, Increment);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// red
Target16^ := MulDiv16(ClampByte(255 - (C8^ - MulDiv16(C8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(255 - (M8^ - MulDiv16(M8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16);
// blue
Target16^ := MulDiv16(ClampByte(255 - (Y8^ - MulDiv16(Y8^, K8^, 255) + K8^)), 65535, 255);
Inc(Target16, 1 + AlphaSkip);

Inc(C8, Increment);
Inc(M8, Increment);
Inc(Y8, Increment);
Inc(K8, Increment);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 4 then
begin
// plane mode
C16 := Source[0];
M16 := Source[1];
Y16 := Source[2];
K16 := Source[3];
Increment := 1;
end
else
begin
// interleaved mode
C16 := Source[0];
M16 := C16; Inc(M16);
Y16 := M16; Inc(Y16);
K16 := Y16; Inc(K16);
Increment := 4;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// red
Target8^ := ClampByte(255 - MulDiv16((C16^ - MulDiv16(C16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8);
// green
Target8^ := ClampByte(255 - MulDiv16((M16^ - MulDiv16(M16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8);
// blue
Target8^ := ClampByte(255 - MulDiv16((Y16^ - MulDiv16(Y16^, K16^, 65535) + K16^), 255, 65535));
Inc(Target8, 1 + AlphaSkip);

Inc(C16, Increment);
Inc(M16, Increment);
Inc(Y16, Increment);
Inc(K16, Increment);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// red
Target16^ := 65535 - (C16^ - MulDiv16(C16^, K16^, 65535) + K16^);
Inc(Target16);
// green
Target16^ := 65535 - (M16^ - MulDiv16(M16^, K16^, 65535) + K16^);
Inc(Target16);
// blue
Target16^ := 65535 - (Y16^ - MulDiv16(Y16^, K16^, 65535) + K16^);
Inc(Target16, 1 + AlphaSkip);

Inc(C16, Increment);
Inc(M16, Increment);
Inc(Y16, Increment);
Inc(K16, Increment);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertGray(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// conversion from source grayscale (possibly with alpha) to target grayscale
// Note: Since grayscale is basically handled like indexed mode (palette), there is no need to
// handle gamma correction here as this happend already during palette creation.

var
Target8: PByte;
Target16: PWord;
Source8: PByte;
Source16: PWord;
BitRun: Byte;
AlphaSkip: Integer;
Convert16: function(Value: Word): Byte of object;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FSourceOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
case FTargetBPS of
8: // 888 to 888
begin
Source8 := Source[0];
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Target8^ := Source8^;
Inc(Source8, 1 + AlphaSkip);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(Target8);
end;
end;
16: // 888 to 161616
begin
Source8 := Source[0];
Target16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Target16^ := MulDiv16(Source8^, 65535, 255);
Inc(Source8, 1 + AlphaSkip);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(Target16);
end;
end;
end;
16:
case FTargetBPS of
8: // 161616 to 888
begin
Source16 := Source[0];
Target8 := Target;
if coNeedByteSwap in FSourceOptions then Convert16 := ComponentSwapScaleConvert
else Convert16 := ComponentScaleConvert;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Target8^ := Convert16(Source16^);
Inc(Source16, 1 + AlphaSkip);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(Target8);
end;
end;
16: // 161616 to 161616
begin
Source16 := Source[0];
Target16 := Target;

if coNeedByteSwap in FSourceOptions then
begin
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Target16^ := Swap(Source16^);
Inc(Source16, 1 + AlphaSkip);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(Target16);
end;
end
else
begin
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Target16^ := Source16^;
Inc(Source16, 1 + AlphaSkip);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(Target16);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertIndexed8(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// This is the core conversion routine for indexed pixel formats.
// This routine takes care about sample scaling and interlacing.
// Note: 16 bit indexed mode is a bit different (words instead bytes and byte swap) and handled separately.

var
SourceRun,
TargetRun: PByte;
Value,
BitRun,
TargetMask,
SourceMask,
SourceShift,
TargetShift,
MaxInSample,
MaxOutSample,
SourceBPS, // local copies to ease assembler access
TargetBPS: Byte;
Done: Cardinal;

begin
SourceRun := Source[0];
TargetRun := Target;

if (FSourceBPS = FTargetBPS) and (Mask = $FF) then Move(SourceRun^, TargetRun^, (Count * FSourceBPS + 7) div 8)
else
begin
BitRun := $80;
// make a copy of these both values from private variables to local variables
// to ease access during assembler parts in the code
SourceBPS := FSourceBPS;
TargetBPS := FTargetBPS;
SourceMask := Byte(not ((1 shl (8 - SourceBPS)) - 1));
MaxInSample := (1 shl SourceBPS) - 1;
TargetMask := (1 shl (8 - TargetBPS)) - 1;
MaxOutSample := (1 shl TargetBPS) - 1;
SourceShift := 8;
TargetShift := 8 - TargetBPS;
Done := 0;
while Done < Count do
begin
if Boolean(Mask and BitRun) then
begin
// adjust shift value by source bit depth
Dec(SourceShift, SourceBPS);
Value := (SourceRun^ and SourceMask) shr SourceShift;
Value := MulDiv16(Value, MaxOutSample, MaxInSample);
TargetRun^ := (TargetRun^ and TargetMask) or (Value shl TargetShift);
if SourceShift = 0 then
begin
SourceShift := 8;
Inc(SourceRun);
end;
asm
MOV CL, [SourceBPS]
ROR BYTE PTR [SourceMask], CL // roll source bit mask with source bit count
end;
end;

asm
ROR BYTE PTR [BitRun], 1 // adjust test bit mask
MOV CL, [TargetBPS]
ROR BYTE PTR [TargetMask], CL // roll target mask with target bit count
end;
if TargetShift = 0 then TargetShift := 8 - TargetBPS
else Dec(TargetShift, TargetBPS);
Inc(Done);
// advance target pointer every (8 div target bit count)
if (Done mod (8 div TargetBPS)) = 0 then Inc(TargetRun);
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertIndexedBoth16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// This is the core conversion routine for indexed pixel formats with 16 bits per sample values involved
// (special version for source and target resolution being both 16 BPS).

var
TargetRun,
SourceRun: PWord;
BitRun: Byte;

begin
SourceRun := Source[0];
TargetRun := Target;
BitRun := $80;

if coNeedByteSwap in FSourceOptions then
begin
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun^ := Swap(SourceRun^);
Inc(SourceRun);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRun);
end;
end
else
begin
if Mask = $FF then Move(SourceRun^, TargetRun^, 2 * Count)
else
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun^ := SourceRun^;
Inc(SourceRun);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRun);
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertIndexedSource16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// This is the core conversion routine for indexed pixel formats with 16 bits per source sample values involved.

var
TargetRun8: PByte;
SourceRun16: PWord;
Value,
BitRun,
TargetMask,
TargetShift,
MaxOutSample,
TargetBPS: Byte; // local copies to ease assembler access

begin
SourceRun16 := Source[0];
TargetRun8 := Target;
BitRun := $80;
// make a copy of these both values from private variables to local variables
// to ease access during assembler parts in the code
TargetBPS := FTargetBPS;
TargetMask := (1 shl (8 - TargetBPS)) - 1;
MaxOutSample := (1 shl TargetBPS) - 1;
TargetShift := 8 - TargetBPS;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
if coNeedByteSwap in FSourceOptions then Value := MulDiv16(Swap(SourceRun16^), MaxOutSample, 65535)
else Value := MulDiv16(SourceRun16^, MaxOutSample, 65535);
TargetRun8^ := (TargetRun8^ and TargetMask) or (Value shl TargetShift);
Inc(SourceRun16);
end;

asm
ROR BYTE PTR [BitRun], 1 // adjust test bit mask
MOV CL, [TargetBPS]
ROR BYTE PTR [TargetMask], CL // roll target mask with target bit count
end;
if TargetShift = 0 then TargetShift := 8 - TargetBPS
else Dec(TargetShift, TargetBPS);
Dec(Count);
// advance target pointer every (8 div target bit count)
if (Count mod (8 div TargetBPS)) = 0 then Inc(TargetRun8);
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertIndexedTarget16(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// This is the core conversion routine for indexed pixel formats with 16 bits per target sample values involved.

var
SourceRun8: PByte;
TargetRun16: PWord;
Value: Word;
BitRun,
SourceMask,
SourceShift,
MaxInSample,
SourceBPS: Byte;

begin
SourceRun8 := Source[0];
TargetRun16 := Target;
BitRun := $80;
SourceBPS := FSourceBPS;
SourceMask := Byte(not ((1 shl (8 - SourceBPS)) - 1));
MaxInSample := (1 shl SourceBPS) - 1;
SourceShift := 8;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
// adjust shift value by source bit depth
Dec(SourceShift, SourceBPS);
Value := (SourceRun8^ and SourceMask) shr SourceShift;
Value := MulDiv16(Value, 65535, MaxInSample);
if coNeedByteSwap in FSourceOptions then TargetRun16^ := Swap(Value)
else TargetRun16^ := Value;
if SourceShift = 0 then
begin
SourceShift := 8;
Inc(SourceRun8);
end;
asm
MOV CL, [SourceBPS]
ROR BYTE PTR [SourceMask], CL // roll source bit mask with source bit count
end;
end;

asm
ROR BYTE PTR [BitRun], 1 // adjust test bit mask
end;

Dec(Count);
// advance target pointer every (8 div target bit count)
Inc(TargetRun16);
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertRGB2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// Converts RGB source schemes to BGR target schemes and takes care for byte swapping, alpha copy/skip and
// gamma correction.

var
SourceR16,
SourceG16,
SourceB16,
SourceA16: PWord;

SourceR8,
SourceG8,
SourceB8,
SourceA8: PByte;

TargetRun16: PBGR16;
TargetRunA16: PBGRA16;
TargetRun8: PBGR;
TargetRunA8: PBGRA;
BitRun: Byte;

Convert8_8: function(Value: Byte): Byte of object;
Convert16_8: function(Value: Word): Byte of object;
Convert16_8Alpha: function(Value: Word): Byte of object;
Convert16_16: function(Value: Word): Word of object;

SourceIncrement,
TargetIncrement: Cardinal;
CopyAlpha: Boolean;

begin
BitRun := $80;
// determine alpha handling once
CopyAlpha := False;
if coAlpha in FSourceOptions then
begin
// byte size of components doesn't matter as the increments are applied to
// pointers whose data types determine the final increment
SourceIncrement := SizeOf(TRGBA);
TargetIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then CopyAlpha := True;
end
else
begin
SourceIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then TargetIncrement := SizeOf(TRGBA)
else TargetIncrement := SizeOf(TRGB);
end;
// in planar mode source increment is always 1
if Length(Source) > 1 then SourceIncrement := 1;

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
// interleaved mode
SourceR8 := Source[0];
SourceG8 := SourceR8; Inc(SourceG8);
SourceB8 := SourceG8; Inc(SourceB8);
SourceA8 := SourceB8; Inc(SourceA8);
end
else
begin
SourceR8 := Source[0];
SourceG8 := Source[1];
SourceB8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

case FTargetBPS of
8: // 888 to 888
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert8_8(SourceR8^);
TargetRunA8.G := Convert8_8(SourceG8^);
TargetRunA8.B := Convert8_8(SourceB8^);
// alpha values are never gamma corrected
TargetRunA8.A := SourceA8^;

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert8_8(SourceR8^);
TargetRun8.G := Convert8_8(SourceG8^);
TargetRun8.B := Convert8_8(SourceB8^);

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 888 to 161616
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;
if Length(Source) = 1 then
begin
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRunA16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRunA16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));
TargetRunA16.A := Convert16_16(MulDiv16(SourceA8^, 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRun16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRun16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
SourceR16 := Source[0];
SourceG16 := SourceR16; Inc(SourceG16);
SourceB16 := SourceG16; Inc(SourceB16);
SourceA16 := SourceB16; Inc(SourceA16);
end
else
begin
SourceR16 := Source[0];
SourceG16 := Source[1];
SourceB16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

case FTargetBPS of
8: // 161616 to 888
begin
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleGammaConvert
else Convert16_8 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleConvert
else Convert16_8 := ComponentScaleConvert;
end;
// since alpha channels are never gamma corrected we need a separate conversion routine
if coNeedByteSwap in FSourceOptions then Convert16_8Alpha := ComponentSwapScaleConvert
else Convert16_8Alpha := ComponentScaleConvert;

if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert16_8(SourceR16^);
TargetRunA8.G := Convert16_8(SourceG16^);
TargetRunA8.B := Convert16_8(SourceB16^);
TargetRunA8.A := Convert16_8Alpha(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert16_8(SourceR16^);
TargetRun8.G := Convert16_8(SourceG16^);
TargetRun8.B := Convert16_8(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 161616 to 161616
begin
// no gamma correction for 16 bit samples yet
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;

if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(SourceR16^);
TargetRunA16.G := Convert16_16(SourceG16^);
TargetRunA16.B := Convert16_16(SourceB16^);
TargetRunA16.A := Convert16_16(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(SourceR16^);
TargetRun16.G := Convert16_16(SourceG16^);
TargetRun16.B := Convert16_16(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertRGB2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// same as ConvertRGB2BGR but for RGB target schemes

var
SourceR16,
SourceG16,
SourceB16,
SourceA16: PWord;

SourceR8,
SourceG8,
SourceB8,
SourceA8: PByte;

TargetRun16: PRGB16;
TargetRunA16: PRGBA16;
TargetRun8: PRGB;
TargetRunA8: PRGBA;
BitRun: Byte;

Convert8_8: function(Value: Byte): Byte of object;
Convert16_8: function(Value: Word): Byte of object;
Convert16_8Alpha: function(Value: Word): Byte of object;
Convert16_16: function(Value: Word): Word of object;

SourceIncrement,
TargetIncrement: Cardinal;
CopyAlpha: Boolean;

begin
BitRun := $80;
// determine alpha handling once
CopyAlpha := False;
if coAlpha in FSourceOptions then
begin
SourceIncrement := SizeOf(TRGBA);
TargetIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then CopyAlpha := True;
end
else
begin
SourceIncrement := SizeOf(TRGB);
if coAlpha in FTargetOptions then TargetIncrement := SizeOf(TRGBA)
else TargetIncrement := SizeOf(TRGB);
end;
// in planar mode source increment is always 1
if Length(Source) > 1 then SourceIncrement := 1;

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
// interleaved mode
SourceR8 := Source[0];
SourceG8 := SourceR8; Inc(SourceG8);
SourceB8 := SourceG8; Inc(SourceB8);
SourceA8 := SourceB8; Inc(SourceA8);
end
else
begin
SourceR8 := Source[0];
SourceG8 := Source[1];
SourceB8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

case FTargetBPS of
8: // 888 to 888
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert8_8(SourceR8^);
TargetRunA8.G := Convert8_8(SourceG8^);
TargetRunA8.B := Convert8_8(SourceB8^);
// alpha values are never gamma corrected
TargetRunA8.A := SourceA8^;

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert8_8(SourceR8^);
TargetRun8.G := Convert8_8(SourceG8^);
TargetRun8.B := Convert8_8(SourceB8^);

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 888 to 161616
begin
if coApplyGamma in FTargetOptions then Convert8_8 := ComponentGammaConvert
else Convert8_8 := ComponentNoConvert8;
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;
if Length(Source) = 1 then
begin
SourceB8 := Source[0];
SourceG8 := SourceB8; Inc(SourceG8);
SourceR8 := SourceG8; Inc(SourceR8);
SourceA8 := SourceR8; Inc(SourceA8);
end
else
begin
SourceB8 := Source[0];
SourceG8 := Source[1];
SourceR8 := Source[2];
if coAlpha in FSourceOptions then SourceA8 := Source[3]
else SourceA8 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRunA16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRunA16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));
TargetRunA16.A := Convert16_16(MulDiv16(SourceA8^, 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
Inc(SourceA8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(MulDiv16(Convert8_8(SourceR8^), 65535, 255));
TargetRun16.G := Convert16_16(MulDiv16(Convert8_8(SourceG8^), 65535, 255));
TargetRun16.B := Convert16_16(MulDiv16(Convert8_8(SourceB8^), 65535, 255));

Inc(SourceB8, SourceIncrement);
Inc(SourceG8, SourceIncrement);
Inc(SourceR8, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
SourceR16 := Source[0];
SourceG16 := SourceR16; Inc(SourceG16);
SourceB16 := SourceG16; Inc(SourceB16);
SourceA16 := SourceB16; Inc(SourceA16);
end
else
begin
SourceR16 := Source[0];
SourceG16 := Source[1];
SourceB16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

case FTargetBPS of
8: // 161616 to 888
begin
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleGammaConvert
else Convert16_8 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16_8 := ComponentSwapScaleConvert
else Convert16_8 := ComponentScaleConvert;
end;
// since alpha channels are never gamma corrected we need a separate conversion routine
if coNeedByteSwap in FSourceOptions then Convert16_8Alpha := ComponentSwapScaleConvert
else Convert16_8Alpha := ComponentScaleConvert;

if CopyAlpha then
begin
TargetRunA8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA8.R := Convert16_8(SourceR16^);
TargetRunA8.G := Convert16_8(SourceG16^);
TargetRunA8.B := Convert16_8(SourceB16^);
TargetRunA8.A := Convert16_8Alpha(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA8);
end;
end
else
begin
TargetRun8 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun8.R := Convert16_8(SourceR16^);
TargetRun8.G := Convert16_8(SourceG16^);
TargetRun8.B := Convert16_8(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PByte(TargetRun8), TargetIncrement);
end;
end;
end;
16: // 161616 to 161616
begin
// no gamma correction for 16 bit samples yet
if coNeedByteSwap in FSourceOptions then Convert16_16 := ComponentSwapConvert
else Convert16_16 := ComponentNoConvert16;

if Length(Source) = 1 then
begin
SourceB16 := Source[0];
SourceG16 := SourceB16; Inc(SourceG16);
SourceR16 := SourceG16; Inc(SourceR16);
SourceA16 := SourceR16; Inc(SourceA16);
end
else
begin
SourceB16 := Source[0];
SourceG16 := Source[1];
SourceR16 := Source[2];
if coAlpha in FSourceOptions then SourceA16 := Source[3]
else SourceA16 := nil;
end;

if CopyAlpha then
begin
TargetRunA16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRunA16.R := Convert16_16(SourceR16^);
TargetRunA16.G := Convert16_16(SourceG16^);
TargetRunA16.B := Convert16_16(SourceB16^);
TargetRunA16.A := Convert16_16(SourceA16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
Inc(SourceA16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(TargetRunA16);
end;
end
else
begin
TargetRun16 := Target;
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
TargetRun16.R := Convert16_16(SourceR16^);
TargetRun16.G := Convert16_16(SourceG16^);
TargetRun16.B := Convert16_16(SourceB16^);

Inc(SourceB16, SourceIncrement);
Inc(SourceG16, SourceIncrement);
Inc(SourceR16, SourceIncrement);
end;
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
Inc(PWord(TargetRun16), TargetIncrement);
end;
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertPhotoYCC2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts from PhotoYCC format to BGR(A)

var
Y, Cb, Cr: Integer;
Yf, Cbf, Crf: Single;
Y8Run, Cb8Run, Cr8Run: PByte;
Y16Run, Cb16Run, Cr16Run: PWord;
Target8: PByte;
Target16: PWord;
AlphaSkip: Integer;
BitRun: Byte;
Increment: Integer;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
Y8Run := Source[0];
Cb8Run := Y8Run; Inc(Cb8Run);
Cr8Run := Cb8Run; Inc(Cr8Run);
Increment := 3;
end
else
begin
Y8Run := Source[0];
Cb8Run := Source[1];
Cr8Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);

asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// blue
Target16^ := MulDiv16(ClampByte(Y + FCbToBlueTable[Cb]), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]), 65535, 255);
Inc(Target16);
// red
Target16^ := MulDiv16(ClampByte(Y + FCrToRedTable[Cr]), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
Y16Run := Source[0];
Cb16Run := Y16Run; Inc(Cb16Run);
Cr16Run := Cb16Run; Inc(Cr16Run);
Increment := 3;
end
else
begin
Y16Run := Source[0];
Cb16Run := Source[1];
Cr16Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := MulDiv16(Y16Run^, 255, 65535);
Inc(Y16Run, Increment);
Cb := MulDiv16(Cb16Run^, 255, 65535);
Inc(Cb16Run, Increment);
Cr := MulDiv16(Cr16Run^, 255, 65535);
Inc(Cr16Run, Increment);

// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;

// conversion from 16 to 16 is done with full precision, so there is no
// loss of information, but the code is slower because the lookup tables
// cannot be used
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Yf := 1.3584 * Y16Run^;
Inc(Y16Run, Increment);
Cbf := Cb16Run^ - 40092; // (156 * 65535) div 255
Inc(Cb16Run, Increment);
Crf := Cr16Run^ - 35209; // (137 * 65535) div 255
Inc(Cr16Run, Increment);

// blue
Target16^ := Round(Yf + 2.2179 * Cbf);
Inc(Target16);
// green
Target16^ := Round(Yf - 0.9271435 * Crf - 0.4302726 * Cbf);
Inc(Target16);
// red
Target16^ := Round(Yf + 1.8215 * Crf);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertPhotoYCC2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts from PhotoYCC format to RGB(A)

var
Y, Cb, Cr: Integer;
Yf, Cbf, Crf: Single;
Y8Run, Cb8Run, Cr8Run: PByte;
Y16Run, Cb16Run, Cr16Run: PWord;
Target8: PByte;
Target16: PWord;
AlphaSkip: Integer;
BitRun: Byte;
Increment: Integer;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
Y8Run := Source[0];
Cb8Run := Y8Run; Inc(Cb8Run);
Cr8Run := Cb8Run; Inc(Cr8Run);
Increment := 3;
end
else
begin
Y8Run := Source[0];
Cb8Run := Source[1];
Cr8Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
end
else Inc(Target8, 3 + AlphaSkip);

asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// red
Target16^ := MulDiv16(ClampByte(Y + FCrToRedTable[Cr]), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
// green
Target16^ := MulDiv16(ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]), 65535, 255);
Inc(Target16);
// blue
Target16^ := MulDiv16(ClampByte(Y + FCbToBlueTable[Cb]), 65535, 255);
Inc(Target16);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
Y16Run := Source[0];
Cb16Run := Y16Run; Inc(Cb16Run);
Cr16Run := Cb16Run; Inc(Cr16Run);
Increment := 3;
end
else
begin
Y16Run := Source[0];
Cb16Run := Source[1];
Cr16Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := MulDiv16(Y16Run^, 255, 65535);
Inc(Y16Run, Increment);
Cb := MulDiv16(Cb16Run^, 255, 65535);
Inc(Cb16Run, Increment);
Cr := MulDiv16(Cr16Run^, 255, 65535);
Inc(Cr16Run, Increment);

// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;

// conversion from 16 to 16 is done with full precision, so there is no
// loss of information, but the code is slower because the lookup tables
// cannot be used
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Yf := 1.3584 * Y16Run^;
Inc(Y16Run, Increment);
Cbf := Cb16Run^ - 40092; // (156 * 65535) div 255
Inc(Cb16Run, Increment);
Crf := Cr16Run^ - 35209; // (137 * 65535) div 255
Inc(Cr16Run, Increment);

// red
Target16^ := Round(Yf + 1.8215 * Crf);
Inc(Target16, 1 + AlphaSkip);
// green
Target16^ := Round(Yf - 0.9271435 * Crf - 0.4302726 * Cbf);
Inc(Target16);
// blue
Target16^ := Round(Yf + 2.2179 * Cbf);
Inc(Target16);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertYCbCr2BGR(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts from standard YCbCr to BGR(A)

var
Y, Cb, Cr: Integer;
Yf, Cbf, Crf: Single;
Y8Run, Cb8Run, Cr8Run: PByte;
Y16Run, Cb16Run, Cr16Run: PWord;
Target8: PByte;
Target16: PWord;
AlphaSkip: Integer;
BitRun: Byte;
Increment: Integer;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
Y8Run := Source[0];
Cb8Run := Y8Run; Inc(Cb8Run);
Cr8Run := Cb8Run; Inc(Cr8Run);
Increment := 3;
end
else
begin
Y8Run := Source[0];
Cb8Run := Source[1];
Cr8Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);

asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// blue
Target16^ := MulDiv16(ClampByte(Y + FCbToBlueTable[Cb]), 65535, 255);
Inc(Target16);
// green
Target16^ := MulDiv16(ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]), 65535, 255);
Inc(Target16);
// red
Target16^ := MulDiv16(ClampByte(Y + FCrToRedTable[Cr]), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
Y16Run := Source[0];
Cb16Run := Y16Run; Inc(Cb16Run);
Cr16Run := Cb16Run; Inc(Cr16Run);
Increment := 3;
end
else
begin
Y16Run := Source[0];
Cb16Run := Source[1];
Cr16Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := MulDiv16(Y16Run^, 255, 65535);
Inc(Y16Run, Increment);
Cb := MulDiv16(Cb16Run^, 255, 65535);
Inc(Cb16Run, Increment);
Cr := MulDiv16(Cr16Run^, 255, 65535);
Inc(Cr16Run, Increment);

// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;

// conversion from 16 to 16 is done with full precision, so there is no
// loss of information, but the code is slower because the lookup tables
// cannot be used
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Yf := 1.3584 * Y16Run^;
Inc(Y16Run, Increment);
Cbf := Cb16Run^ - 40092; // (156 * 65535) div 255
Inc(Cb16Run, Increment);
Crf := Cr16Run^ - 35209; // (137 * 65535) div 255
Inc(Cr16Run, Increment);

// blue
Target16^ := Round(Yf + 2.2179 * Cbf);
Inc(Target16);
// green
Target16^ := Round(Yf - 0.9271435 * Crf - 0.4302726 * Cbf);
Inc(Target16);
// red
Target16^ := Round(Yf + 1.8215 * Crf);
Inc(Target16, 1 + AlphaSkip);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.RowConvertYCbCr2RGB(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// converts from standard YCbCr to RGB(A)

var
Y, Cb, Cr: Integer;
Yf, Cbf, Crf: Single;
Y8Run, Cb8Run, Cr8Run: PByte;
Y16Run, Cb16Run, Cr16Run: PWord;
Target8: PByte;
Target16: PWord;
AlphaSkip: Integer;
BitRun: Byte;
Increment: Integer;

begin
BitRun := $80;
AlphaSkip := Ord(coAlpha in FTargetOptions); // 0 if no alpha must be skipped, otherwise 1

case FSourceBPS of
8:
begin
if Length(Source) = 1 then
begin
Y8Run := Source[0];
Cb8Run := Y8Run; Inc(Cb8Run);
Cr8Run := Cb8Run; Inc(Cr8Run);
Increment := 3;
end
else
begin
Y8Run := Source[0];
Cb8Run := Source[1];
Cr8Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 888 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
end
else Inc(Target8, 3 + AlphaSkip);

asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 888 to 161616
begin
Target16 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := Y8Run^;
Inc(Y8Run, Increment);
Cb := Cb8Run^;
Inc(Cb8Run, Increment);
Cr := Cr8Run^;
Inc(Cr8Run, Increment);

// red
Target16^ := MulDiv16(ClampByte(Y + FCrToRedTable[Cr]), 65535, 255);
Inc(Target16, 1 + AlphaSkip);
// green
Target16^ := MulDiv16(ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]), 65535, 255);
Inc(Target16);
// blue
Target16^ := MulDiv16(ClampByte(Y + FCbToBlueTable[Cb]), 65535, 255);
Inc(Target16);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
16:
begin
if Length(Source) = 1 then
begin
Y16Run := Source[0];
Cb16Run := Y16Run; Inc(Cb16Run);
Cr16Run := Cb16Run; Inc(Cr16Run);
Increment := 3;
end
else
begin
Y16Run := Source[0];
Cb16Run := Source[1];
Cr16Run := Source[2];
Increment := 1;
end;

case FTargetBPS of
8: // 161616 to 888
begin
Target8 := Target;

while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Y := MulDiv16(Y16Run^, 255, 65535);
Inc(Y16Run, Increment);
Cb := MulDiv16(Cb16Run^, 255, 65535);
Inc(Cb16Run, Increment);
Cr := MulDiv16(Cr16Run^, 255, 65535);
Inc(Cr16Run, Increment);

// red
Target8^ := ClampByte(Y + FCrToRedTable[Cr]);
Inc(Target8, 1 + AlphaSkip);
// green
Target8^ := ClampByte(Y + FCbToGreenTable[Cb] + FCrToGreentable[Cr]);
Inc(Target8);
// blue
Target8^ := ClampByte(Y + FCbToBlueTable[Cb]);
Inc(Target8);
end
else Inc(Target8, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
16: // 161616 to 161616
begin
Target16 := Target;

// conversion from 16 to 16 is done with full precision, so there is no
// loss of information, but the code is slower because the lookup tables
// cannot be used
while Count > 0 do
begin
if Boolean(Mask and BitRun) then
begin
Yf := 1.3584 * Y16Run^;
Inc(Y16Run, Increment);
Cbf := Cb16Run^ - 40092; // (156 * 65535) div 255
Inc(Cb16Run, Increment);
Crf := Cr16Run^ - 35209; // (137 * 65535) div 255
Inc(Cr16Run, Increment);

// red
Target16^ := Round(Yf + 1.8215 * Crf);
Inc(Target16, 1 + AlphaSkip);
// green
Target16^ := Round(Yf - 0.9271435 * Crf - 0.4302726 * Cbf);
Inc(Target16);
// blue
Target16^ := Round(Yf + 2.2179 * Cbf);
Inc(Target16);
end
else Inc(Target16, 3 + AlphaSkip);
asm ROR BYTE PTR [BitRun], 1 end;
Dec(Count);
end;
end;
end;
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.CreateYCbCrLookup;

// In order to speedup YCbCr conversion lookup tables are used, this methods creates them.
// R := Y + Cr * (2 - 2 * LumaRed);
// B := Y + Cb * (2 - 2 * LumaBlue);
// G := Y - LumaBlue * Cb * (2 - 2 * LumaBlue) / LumaGreen
// - LumaRed * Cr * (2 - 2 * LumaRed) / LumaGreen;
//
// To avoid floating point arithmetic the fractional constants that come out of the equations are represented
// as fixed point values in the range 0...2^16. We also eliminate multiplications by // pre-calculating possible
// values indexed by Cb and Cr (this code assumes conversion is being done for 8-bit samples).
//
// Note: the color manager uses dynamic arrays so the memory used here is automatically freed.
//
// Needed settings:
// - YCbCr parameters must be set or default values are used

var
F1, F2, F3, F4: Single;
LumaRed,
LumaGreen,
LumaBlue: Single;
I: Integer;
Offset1, Offset2: Integer;

begin
LumaRed := FYCbCrCoefficients[0];
LumaGreen := FYCbCrCoefficients[1];
LumaBlue := FYCbCrCoefficients[2];

F1 := 2 - 2 * LumaRed;
F2 := LumaRed * F1 / LumaGreen;
F3 := 2 - 2 * LumaBlue;
F4 := LumaBlue * F3 / LumaGreen;

SetLength(FCrToRedTable, 256);
SetLength(FCbToBlueTable, 256);
SetLength(FCrToGreenTable, 256);
SetLength(FCbToGreenTable, 256);

if FSourceScheme = csYCbCr then
begin
// I is the actual input pixel value in the range 0..255, Cb and Cr values are in the range -128..127.
// (for TIFF files they are in a range defined by the ReferenceBlackWhite tag).
Offset1 := -128;
for I := 0 to 255 do
begin
FCrToRedTable := Round(F1 * Offset1);
FCbToBlueTable := Round(F3 * Offset1);
FCrToGreenTable := -Round(F2 * Offset1);
FCbToGreenTable := -Round(F4 * Offset1);
Inc(Offset1);
end;
end
else
begin
// PhotoYCC
// I is the actual input pixel value in the range 0..255, Cb values are in the range -156..99,
// Cr values are in the range -137..118.
// (for TIFF files they are in a range defined by the ReferenceBlackWhite tag).
Offset1 := -156;
Offset2 := -137;
for I := 0 to 255 do
begin
FCrToRedTable := Round(F1 * Offset2);
FCbToBlueTable := Round(F3 * Offset1);
FCrToGreenTable := -Round(F2 * Offset2);
FCbToGreenTable := -Round(F4 * Offset1);
Inc(Offset1);
Inc(Offset2);
end;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.GetPixelFormat(Index: Integer): TPixelFormat;

// determines the pixel format from the current sample and pixel sizes
// Note: setting pfCustom as pixel format will raise an exception so check the result from this method first
// before you actually assign it to a bitmap.
//
// Needed settings:
// - source samples per pixel and bits per sample for Index = 0
// - target samples per pixel and bits per sample for Index = 1

var
SamplesPerPixel,
BitsPerSample: Byte;

begin
case Index of
0:
begin
SamplesPerPixel := FSourceSPP;
BitsPerSample := FSourceBPS;
end;
else
SamplesPerPixel := FTargetSPP;
BitsPerSample := FTargetBPS;
end;

case SamplesPerPixel of
1: // one sample per pixel, this is usually a palette format
case BitsPerSample of
1:
Result := pf1Bit;
2..4: // values < 4 should be upscaled
Result := pf4bit;
8..16:
// values > 8 bits must be downscaled to 8 bits
Result := pf8bit;
else
Result := pfCustom;
end;
3: // Typical case is RGB or CIE L*a*b* (565 and 555 16 bit color formats would also be possible, but aren't handled
// by the manager).
case BitsPerSample of
1..5: // values < 5 should be upscaled
Result := pf15Bit;
else
// values > 8 bits should be downscaled
Result := pf24bit;
end;
4: // Typical cases: RGBA and CMYK (with 8 bps, other formats like PCX's
// 4 planes with 1 bit must be handled elsewhere)
if BitsPerSample >= 8 then Result := pf32Bit
else Result := pfCustom;
else
Result := pfCustom;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.PrepareConversion;

// depending on the source and target pixel and color formats a conversion function must be
// determined which actually carries out the conversion
//
// Needed settings:
// - source and target samples per pixel and bits per sample
// - source and target color scheme

begin
FRowConversion := nil;

// Conversion between indexed and non-indexed formats is not supported as well as
// between source BPS < 8 and target BPS > 8.
// csGA and csG (grayscale w and w/o alpha) are considered being indexed modes
if (FSourceScheme in [csIndexed, csG, csGA]) xor
(FTargetScheme in [csIndexed, csG]) then Error(gesIndexedNotSupported);

// set up special conversion options
if FSourceScheme in [csGA, csRGBA, csBGRA] then Include(FSourceOptions, coAlpha)
else Exclude(FSourceOptions, coAlpha);

if FTargetScheme in [csGA, csRGBA, csBGRA] then Include(FTargetOptions, coAlpha)
else Exclude(FTargetOptions, coAlpha);

case FSourceScheme of
csG:
if (FSourceBPS = 16) or (FTargetBPS = 16) then
begin
if (FSourceBPS >= 8) and (FTargetBPS >= 8) then FRowConversion := RowConvertGray;
end
else
FRowConversion := RowConvertIndexed8;
csGA:
if (FSourceBPS in [8, 16]) and (FTargetBPS in [8, 16]) then FRowConversion := RowConvertGray;
csIndexed:
begin
// Grayscale is handled like indexed mode.
// Generally use indexed conversions (with various possible bit operations),
// assign special methods for source only, target only or source and target being 16 bits per sample
if (FSourceBPS = 16) and
(FTargetBPS = 16) then FRowConversion := RowConvertIndexedBoth16
else
if FSourceBPS = 16 then FRowConversion := RowConvertIndexedSource16
else
if FTargetBPS = 16 then FRowConversion := RowConvertIndexedTarget16
else FRowConversion := RowConvertIndexed8;
end;
csRGB,
csRGBA:
case FTargetScheme of
csRGB: FRowConversion := RowConvertRGB2RGB;
csRGBA: FRowConversion := RowConvertRGB2RGB;
csBGR: FRowConversion := RowConvertRGB2BGR;
csBGRA: FRowConversion := RowConvertRGB2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
csBGRA,
csBGR:
case FTargetScheme of
csRGB,
csRGBA: FRowConversion := RowConvertBGR2RGB;
csBGR,
csBGRA: FRowConversion := RowConvertBGR2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
csCMY:
case FTargetScheme of
csRGB: ;
csRGBA: ;
csBGR: ;
csBGRA: ;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
csCMYK:
case FTargetScheme of
csRGB,
csRGBA: FRowConversion := RowConvertCMYK2RGB;
csBGR,
csBGRA: FRowConversion := RowConvertCMYK2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
csCIELab:
case FTargetScheme of
csRGB,
csRGBA: FRowConversion := RowConvertCIELab2RGB;
csBGR,
csBGRA: FRowConversion := RowConvertCIELab2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
csYCbCr:
begin
// create lookup tables to speed up conversion
CreateYCbCrLookup;
case FTargetScheme of
csRGB,
csRGBA: FRowConversion := RowConvertYCbCr2RGB;
csBGR,
csBGRA: FRowConversion := RowConvertYCbCr2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
end;
csPhotoYCC:
begin
// create lookup tables to speed up conversion
CreateYCbCrLookup;
case FTargetScheme of
csRGB,
csRGBA: FRowConversion := RowConvertPhotoYCC2RGB;
csBGR,
csBGRA: FRowConversion := RowConvertPhotoYCC2BGR;
csCMY: ;
csCMYK: ;
csCIELab: ;
csYCbCr: ;
end;
end;
end;
FChanged := False;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetSourceBitsPerSample(const Value: Byte);

begin
if not (Value in [1..16]) then Error(gesInvalidSampleDepth);
if FSourceBPS <> Value then
begin
FSourceBPS := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetSourceColorScheme(const Value: TColorScheme);

begin
if FSourceScheme <> Value then
begin
FSourceScheme := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetSourceSamplesPerPixel(const Value: Byte);

begin
if not (Value in [1..4]) then Error(gesInvalidPixelDepth);
if FSourceSPP <> Value then
begin
FSourceSPP := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetTargetBitsPerSample(const Value: Byte);

begin
if not (Value in [1..16]) then Error(gesInvalidSampleDepth);
if FTargetBPS <> Value then
begin
FTargetBPS := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetTargetColorScheme(const Value: TColorScheme);

begin
if FTargetScheme <> Value then
begin
FTargetScheme := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetTargetSamplesPerPixel(const Value: Byte);

begin
if not (Value in [1..4]) then Error(gesInvalidPixelDepth);
if FTargetSPP <> Value then
begin
FTargetSPP := Value;
FChanged := True;
end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.ConvertRow(Source: array of Pointer; Target: Pointer; Count: Cardinal; Mask: Byte);

// initializes the color conversion method if necessary and calls it to do the actual conversion
//
// Needed settings:
// - source and target BPS and SPP
// - main and display gamma, if gamma correction is wanted
// - conversion options
// - YCbCr parameters if any of the color schemes is csYCbCr

begin
// if there are pending changes then apply them
if FChanged then PrepareConversion;
// check if there's now a conversion method
if @FRowConversion = nil then Error(gesConversionUnsupported)
else FRowConversion(Source, Target, Count, Mask);
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.CreateColorPalette(Data: array of Pointer; DataFormat: TRawPaletteFormat;
ColorCount: Cardinal; RGB: Boolean): HPALETTE;

// Creates a color palette from the provided data which can be in various raw formats:
// - either interlaced or plane
// - 8 bits or 16 bits per component
// - in RGB or BGR order
// - with 3 or 4 components per entry (fourth is ignored)
// ColorCount determines the number of color entries to create. If this number does not equal the
// number of palette entries which would result from the given target bits per sample resolution
// then the palette is adjusted accordingly to allow conversion between resolutions.
//
// Notes: For interlaced formats only one pointer needs to be passed in Data (only the first one is used)
// while for plane data 3 pointers are necessary (for each plane one pointer).
// The data order is assumed rgb or bgr in interlaced order (depending on RGB). In plane mode the three needed
// pointers must also be given such that the pointer to red components is in Data[0], the green pointer in
// Data[1] and the blue one in Data[2]. In this case BGR is not needed.
//
// Needed settings:
// - main and display gamma, if gamma correction is wanted
// - Options set as needed (gamma, byte swap)
// - source and target bits per sample resolution

var
I,
MaxIn, MaxOut: Integer;
LogPalette: TMaxLogPalette;
RunR8,
RunG8,
RunB8: PByte;
RunR16,
RunG16,
RunB16: PWord;
Convert8: function(Value: Byte): Byte of object;
Convert16: function(Value: Word): Byte of object;

begin
FillChar(LogPalette, SizeOf(LogPalette), 0);
LogPalette.palVersion := $300;
if ColorCount > 256 then LogPalette.palNumEntries := 256
else LogPalette.palNumEntries := ColorCount;

case DataFormat of
pfInterlaced8Triple,
pfInterlaced8Quad:
begin
RunR8 := Data[0];
if coApplyGamma in FTargetOptions then Convert8 := ComponentGammaConvert
else Convert8 := ComponentNoConvert8;

if RGB then
begin
for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peBlue := Convert8(RunR8^); Inc(RunR8);
LogPalette.palPalEntry.peGreen := Convert8(RunR8^); Inc(RunR8);
LogPalette.palPalEntry.peRed := Convert8(RunR8^); Inc(RunR8);
if DataFormat = pfInterlaced8Quad then Inc(RunR8);
end;
end
else
begin
for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peRed := Convert8(RunR8^); Inc(RunR8);
LogPalette.palPalEntry.peGreen := Convert8(RunR8^); Inc(RunR8);
LogPalette.palPalEntry.peBlue := Convert8(RunR8^); Inc(RunR8);
if DataFormat = pfInterlaced8Quad then Inc(RunR8);
end;
end;
end;
pfPlane8Triple,
pfPlane8Quad:
begin
RunR8 := Data[0];
RunG8 := Data[1];
RunB8 := Data[2];
if coApplyGamma in FTargetOptions then Convert8 := ComponentGammaConvert
else Convert8 := ComponentNoConvert8;
for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peRed := Convert8(RunR8^); Inc(RunR8);
LogPalette.palPalEntry.peGreen := Convert8(RunG8^); Inc(RunG8);
LogPalette.palPalEntry.peBlue := Convert8(RunB8^); Inc(RunB8);
end;
end;
pfInterlaced16Triple,
pfInterlaced16Quad:
begin
RunR16 := Data[0];
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16 := ComponentSwapScaleGammaConvert
else Convert16 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16 := ComponentSwapScaleConvert
else Convert16 := ComponentScaleConvert;
end;

if RGB then
begin
for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peRed := Convert16(RunR16^); Inc(RunR16);
LogPalette.palPalEntry.peGreen := Convert16(RunR16^); Inc(RunR16);
LogPalette.palPalEntry.peBlue := Convert16(RunR16^); Inc(RunR16);
if DataFormat = pfInterlaced16Quad then Inc(RunR16);
end;
end
else
begin
for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peBlue := Convert16(RunR16^); Inc(RunR16);
LogPalette.palPalEntry.peGreen := Convert16(RunR16^); Inc(RunR16);
LogPalette.palPalEntry.peRed := Convert16(RunR16^); Inc(RunR16);
if DataFormat = pfInterlaced16Quad then Inc(RunR16);
end;
end;
end;
pfPlane16Triple,
pfPlane16Quad:
begin
RunR16 := Data[0];
RunG16 := Data[1];
RunB16 := Data[2];
if coApplyGamma in FTargetOptions then
begin
if coNeedByteSwap in FSourceOptions then Convert16 := ComponentSwapScaleGammaConvert
else Convert16 := ComponentScaleGammaConvert;
end
else
begin
if coNeedByteSwap in FSourceOptions then Convert16 := ComponentSwapScaleConvert
else Convert16 := ComponentScaleConvert;
end;

for I := 0 to LogPalette.palNumEntries - 1 do
begin
LogPalette.palPalEntry.peRed := Convert16(RunR16^); Inc(RunR16);
LogPalette.palPalEntry.peGreen := Convert16(RunG16^); Inc(RunG16);
LogPalette.palPalEntry.peBlue := Convert16(RunB16^); Inc(RunB16);
end;
end;
end;

MaxIn := (1 shl FSourceBPS) - 1;
MaxOut := (1 shl FTargetBPS) - 1;
if (FTargetBPS <= 8) and (MaxIn <> MaxOut) then
begin
// If target resolution and given color depth differ then the palette needs to be adjusted.
// Consider the case for 2 bit to 4 bit conversion. Only 4 colors will be given to create
// the palette but after scaling all values will be up to 15 for which no color is in the palette.
// This and the reverse case need to be accounted for.
MaxIn := (1 shl FSourceBPS) - 1;
MaxOut := (1 shl FTargetBPS) - 1;
if MaxIn < MaxOut then
begin
// palette is too small, enhance it
for I := MaxOut downto 0 do
begin
LogPalette.palPalEntry.peRed := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peRed;
LogPalette.palPalEntry.peGreen := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peGreen;
LogPalette.palPalEntry.peBlue := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peBlue;
end;
end
else
begin
// palette contains too many entries, shorten it
for I := 0 to MaxOut do
begin
LogPalette.palPalEntry.peRed := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peRed;
LogPalette.palPalEntry.peGreen := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peGreen;
LogPalette.palPalEntry.peBlue := LogPalette.palPalEntry[MulDiv16(I, MaxIn, MaxOut)].peBlue;
end;
end;
LogPalette.palNumEntries := MaxOut + 1;
end;

// finally create palette
Result := CreatePalette(PLogPalette(@LogPalette)^);
end;

//----------------------------------------------------------------------------------------------------------------------

function TColorManager.CreateGrayscalePalette(MinimumIsWhite: Boolean): HPALETTE;

// Creates a grayscale palette depending on the target bit depth and returns the handle of it,
// optionally applies gamma to each entry. MinimumIsWhite is True if the palette starts
// with white in index 0 decreasing to black while the index grows otherwise (and this is the usual case)
// a lower palette index has a lower brightness.
//
// Needed settings:
// - target BPS, 16 bits are handled as 8 bits
// - target SPP should be set to 1 (indicating an indexed image), but is not evaluated here
// - main and display gamma, if gamma correction is wanted
// Note: Target bps must not be changed between setting gamma and creating the palette.

var
LogPalette: TMaxLogPalette;
I: Integer;
BPS,
Upper,
Factor: Byte;

begin
FillChar(LogPalette, SizeOf(LogPalette), 0);
LogPalette.palVersion := $300;
// the product of BPS and SPP considers planar organizatons correctly
// (e.g. PCX has a format 4 planes with 1 bit resulting to 16 color image)
BPS := FTargetBPS * FTargetSPP;
if BPS > 8 then BPS := 8;
LogPalette.palNumEntries := 1 shl BPS;
Upper := LogPalette.palNumEntries - 1;
Factor := 255 div Upper;
if MinimumIsWhite then
begin
if not (coApplyGamma in FTargetOptions) then
begin
for I := 0 to Upper do
begin
LogPalette.palPalEntry[Upper - I].peBlue := I * Factor;
LogPalette.palPalEntry[Upper - I].peGreen := I * Factor;
LogPalette.palPalEntry[Upper - I].peRed := I * Factor;
end;
end
else
begin
for I := 0 to Upper do
begin
LogPalette.palPalEntry[Upper - I].peBlue := FGammaTable[I * Factor];
LogPalette.palPalEntry[Upper - I].peGreen := FGammaTable[I * Factor];
LogPalette.palPalEntry[Upper - I].peRed := FGammaTable[I * Factor];
end;
end;
end
else
begin
if not (coApplyGamma in FTargetOptions) then
begin
for I := 0 to Upper do
begin
LogPalette.palPalEntry.peBlue := I * Factor;
LogPalette.palPalEntry.peGreen := I * Factor;
LogPalette.palPalEntry.peRed := I * Factor;
end;
end
else
begin
for I := 0 to Upper do
begin
LogPalette.palPalEntry.peBlue := FGammaTable[I * Factor];
LogPalette.palPalEntry.peGreen := FGammaTable[I * Factor];
LogPalette.palPalEntry.peRed := FGammaTable[I * Factor];
end;
end;
end;
// finally create palette
Result := CreatePalette(PLogPalette(@LogPalette)^);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.Error(const Msg: String);

begin
raise EColorConversionError.Create(Msg);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetGamma(MainGamma, DisplayGamma: Single);

// sets the current gamma values and creates the gamma lookup table
//
// Needed settings:
// - source bits per samples must be set
// - target bits per samples must be set

var
I,
SourceHighBound,
TargetHighBound: Integer;
Gamma: Single;

begin
if MainGamma <= 0 then FMainGamma := 1
else FMainGamma := MainGamma;
if DisplayGamma <= 0 then FDisplayGamma := 2.2 // default value for a usual CRT
else FDisplayGamma := DisplayGamma;

Gamma := 1 / (FMainGamma * FDisplayGamma);

// source high bound is the maximum possible source value which can appear (0..255)
if FSourceBPS >= 8 then SourceHighBound := 255
else SourceHighBound := (1 shl FTargetBPS) - 1;
// target high bound is the target value which corresponds to a target sample value of 1 (0..255)
if FTargetBPS >= 8 then TargetHighBound := 255
else TargetHighBound := (1 shl FTargetBPS) - 1;
for I := 0 to SourceHighBound do
FGammaTable := Round(Power((I / SourceHighBound), Gamma) * TargetHighBound);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TColorManager.SetYCbCrParameters(Values: array of Single; HSubSampling, VSubSampling: Byte);

// sets coefficients needed to convert from YCbCr color scheme

begin
// there must always be at least one value in an open array
FYCbCrCoefficients[0] := Values[0];
if High(Values) > 0 then
begin
FYCbCrCoefficients[1] := Values[1];
if High(Values) > 1 then FYCbCrCoefficients[2] := Values[2];
end;

// subsampling can be 1, 2 or 4 and vertical subsampling must always be <= horizontal subsampling
if not (HSubSampling in [1, 2, 4]) then Error(gesInvalidSubSampling);
if not (VSubSampling in [1, 2, 4]) then Error(gesInvalidSubSampling);
if VSubSampling > HSubSampling then Error(gesVerticalSubSamplingError);
FHSubSampling := HSubSampling;
FVSubSampling := VSubSampling;
end;

//----------------------------------------------------------------------------------------------------------------------

end.

谢谢楼上提供的代码。。。。


sorry， 真的还是差好远（不但跟photoshop差远啦，而且跟实际的测量仪器测出来的效果比较也差好远）

function MulDiv16(Number, Numerator, Denominator: Word): Word;
// faster equivalent to Windows' MulDiv function
// Number is passed via AX
// Numerator is passed via DX
// Denominator is passed via CX
// Result is passed via AX
// Note: No error checking takes place. Denominator must be > 0!
asm
MUL DX
DIV CX
end;

function ClampByte(Value: Integer): Byte;
// ensures Value is in the range 0..255, values < 0 are clamped to 0 and values > 255 are clamped to 255
asm
OR EAX, EAX
JNS @@positive
XOR EAX, EAX
RET
@@positive:
CMP EAX, 255
JBE @@OK
MOV EAX, 255
@@OK:
end;

procedure CIELabToRGB(L, a, b: double; var R1, G1, B1: integer);
var
T, YYn3: double;
X, Y, Z: double;
begin
YYn3 := (L + 16) / 116; // this corresponds to (Y/Yn)^1/3
if L < 7.9996 then
begin
Y := L / 903.3;
X := a / 3893.5 + Y;
Z := Y - b / 1557.4;
end
else
begin
T := YYn3 + a / 500;
X := T * T * T;
Y := YYn3 * YYn3 * YYn3;
T := YYn3 - b / 200;
Z := T * T * T;
end;
B1 := ClampByte(Round(255 * ( 0.099 * X - 0.198 * Y + 1.099 * Z)));
G1 := ClampByte(Round(255 * (-0.952 * X + 1.893 * Y + 0.059 * Z)));
R1 := ClampByte(Round(255 * ( 2.998 * X - 1.458 * Y - 0.541 * Z)));
end;

结果跟实际测量的效果差异很大