function CreateBitmap: TBitmap;
begin
Result := TBitmap.Create;
Result.SetSize(1, 1);
end;
function SingleColor(
const AColor: TColor): TBitmap;
begin
Result := CreateBitmap;
Result.Canvas.Pixels[0, 0] := AColor;
end;
function GetColor(
const ABitmap: TBitmap): TColor;
begin
Result := ABitmap.Canvas.Pixels[0, 0];
end;
var
SrcProfile, DstProfile:
string;
hSrc, hDest: cmsHPROFILE;
Transform: cmsHTRANSFORM;
Intent: Integer;
dwFlags: DWORD;
InColor, OutColor: TBitmap;
begin
SrcProfile := TICCProfileItem(cbRGBProfiles.Items.Objects[cbRGBProfiles.ItemIndex]).Path;
DstProfile := TICCProfileItem(cbCMYKProfiles.Items.Objects[cbCMYKProfiles.ItemIndex]).Path;
if cbCompensation.Checked
then
dwFlags := cmsFLAGS_BLACKPOINTCOMPENSATION
else
dwFlags := 0
;
Intent := IntentCodes[cbIntents.ItemIndex];
//cmsSetAdaptationState(cmsSetAdaptationState(-1));
if (SrcProfile <> '
')
and (DstProfile <> '
')
then
begin
hSrc := cmsOpenProfileFromFile(PAnsiChar(AnsiString(SrcProfile)), '
r');
hDest := cmsOpenProfileFromFile(PAnsiChar(AnsiString(DstProfile)), '
r');
if (hSrc <>
nil)
and (hDest <>
nil)
then
Transform := cmsCreateTransform(hSrc, TYPE_BGR_8, hDest, TYPE_BGR_8,
Intent, dwFlags)
else
Transform :=
nil
;
if hSrc <>
nil then
cmsCloseProfile(hSrc);
;
if hDest <>
nil then
cmsCloseProfile(hDest);
;
InColor := SingleColor(
RGB(255, 0, 0));
OutColor := CreateBitmap;
OutColor.Assign(InColor);
if (Transform <>
nil)
then
try
cmsDoTransform(Transform, InColor.Scanline[0], OutColor.Scanline[0], 1);
finally
cmsDeleteTransform(Transform);
end;
Color := SingleColor(OutColor);
end
end;