ielcms.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

function AllocEmptyTransform: _LPcmsTRANSFORM;
var
  p: _LPcmsTRANSFORM;
begin

  getmem(p, sizeof(_cmsTRANSFORM));
  if (p = nil) then
  begin
    //cmsSignalError(LCMS_ERRC_ABORTED, "cmsCreateTransform: malloc() failed");
    result := nil;
    exit;
  end;
  ZeroMemory(p, sizeof(_cmsTRANSFORM));

  p^.xform := nil;
  p^.Intent := INTENT_PERCEPTUAL;
  p^.ProofIntent := INTENT_ABSOLUTE_COLORIMETRIC;
  p^.DoGamutCheck := 0;
  p^.InputProfile := nil;
  p^.OutputProfile := nil;
  p^.PreviewProfile := nil;
  p^.Preview := nil;
  p^.Gamut := nil;
  p^.DeviceLink := nil;
  p^.InMatShaper := nil;
  p^.OutMatShaper := nil;
  p^.SmeltMatShaper := nil;
  p^.NamedColorList := nil;
  p^.EntryColorSpace := icColorSpaceSignature(0);
  p^.ExitColorSpace := icColorSpaceSignature(0);

  result := p;
end;

function _cmsEndPointsBySpace(Space: icColorSpaceSignature; var White: pword; var Black: pword; nOutputs: pinteger): longbool;
const
  RGBblack: array[0..3] of word = (0, 0, 0, 0);
  RGBwhite: array[0..3] of word = ($FFFF, $FFFF, $FFFF, 0);
  CMYKblack: array[0..3] of word = ($FFFF, $FFFF, $FFFF, $FFFF);
  CMYKwhite: array[0..3] of word = (0, 0, 0, 0);
  LABblack: array[0..3] of word = (0, $8000, $8000, 0);
  LABwhite: array[0..3] of word = ($FF00, $8000, $8000, 0);
  CMYblack: array[0..3] of word = ($FFFF, $FFFF, $FFFF, 0);
  CMYwhite: array[0..3] of word = (0, 0, 0, 0);
begin
  case (Space) of

    icSigRgbData:
      begin
        White := @RGBwhite;
        Black := @RGBblack;
        nOutputs^ := 3;
        result := true;
        exit;
      end;

    icSigLabData:
      begin
        White := @LABwhite;
        Black := @LABblack;
        nOutputs^ := 3;
        result := true;
        exit;
      end;

    icSigCmykData:
      begin
        White := @CMYKwhite;
        Black := @CMYKblack;
        nOutputs^ := 4;
        result := true;
        exit;
      end;

    icSigCmyData:
      begin
        White := @CMYwhite;
        Black := @CMYblack;
        nOutputs^ := 3;
        result := true;
        exit;
      end;
  end;

  result := false;
end;

function _cmsWhiteBySpace(Space: icColorSpaceSignature): PWORD;
const
  Default: array[0..MAXCHANNELS - 1] of word = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
var
  White, Black: pword;
  Dummy: integer;
begin
  White := nil;
  Black := nil;
  if (_cmsEndPointsBySpace(Space, White, Black, @Dummy)) then
    result := White
  else
    result := @Default;
end;

function cmsGetColorSpace(hProfile: cmsHPROFILE): icColorSpaceSignature;
var
  Icc: LPLCMSICCPROFILE;
begin
  Icc := LPLCMSICCPROFILE(hProfile);
  result := Icc^.ColorSpace;
end;

procedure COPY_3CHANS(xto, xfrom: pwordarray); {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  xto[0] := xfrom[0];
  xto[1] := xfrom[1];
  xto[2] := xfrom[2];
end;

function FROM_V2_TO_V4(x: word): word; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := (((((x) shl 8) + (x)) + $80) shr 8);
end;

function FROM_V4_TO_V2(x: word): word; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := ((((x) shl 8) + $80) div 257);
end;

function ToFixedDomain(a: integer): Fixed32; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := a + ((a + $7FFF) div $FFFF);
end;

function FromFixedDomain(a: Fixed32): integer; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := a - ((a + $7FFF) shr 16);
end;

(*
function FixedMul(a: Fixed32; b: Fixed32): Fixed32;
begin
  result := round(((a / 65536) * (b / 65536)) * 65536 );
end;
*)

procedure MAT3evalW(r: LPWVEC3; a: LPWMAT3; v: LPWVEC3);
var
  o1,o2,o3:double;
begin
  with v^ do
  begin
    o1:=n[0] / 65536;
    o2:=n[1] / 65536;
    o3:=n[2] / 65536;
  end;
  with a^.v[0] do
    r^.n[VX] := round(((n[0] / 65536) * o1) * 65536 ) +
                round(((n[1] / 65536) * o2) * 65536 ) +
                round(((n[2] / 65536) * o3) * 65536 );

  with a^.v[1] do
    r^.n[VY] := round(((n[0] / 65536) * o1) * 65536 ) +
                round(((n[1] / 65536) * o2) * 65536 ) +
                round(((n[2] / 65536) * o3) * 65536 );

  with a^.v[2] do
    r^.n[VZ] := round(((n[0] / 65536) * o1) * 65536 ) +
                round(((n[1] / 65536) * o2) * 65536 ) +
                round(((n[2] / 65536) * o3) * 65536 );

  (*
  r^.n[VX] := FixedMul(a^.v[0].n[0], v^.n[0]) +
              FixedMul(a^.v[0].n[1], v^.n[1]) +
              FixedMul(a^.v[0].n[2], v^.n[2]);

  r^.n[VY] := FixedMul(a^.v[1].n[0], v^.n[0]) +
              FixedMul(a^.v[1].n[1], v^.n[1]) +
              FixedMul(a^.v[1].n[2], v^.n[2]);

  r^.n[VZ] := FixedMul(a^.v[2].n[0], v^.n[0]) +
              FixedMul(a^.v[2].n[1], v^.n[1]) +
              FixedMul(a^.v[2].n[2], v^.n[2]);
  *)
end;

function Clamp_RGB(xin: integer): word; 
begin
  if (xin < 0) then
  begin
    result := 0;
    exit;
  end;
  if (xin > $FFFF) then
    result := $FFFF
  else
    result := xin;
end;

function cmsLinearInterpLUT16(Value: WORD; LutTable: pwordarray; p: LPL16PARAMS): word;
var
  y1, y0: double;
  y: double;
  val2, rest: double;
  cell0, cell1: integer;
begin
  if (Value = $FFFF) then
  begin
    result := LutTable[p^.Domain];
    exit;
  end;

  val2 := p^.Domain * (Value / 65535.0);

  cell0 := iefloor(val2);
  cell1 := ieceil(val2);

  rest := val2 - cell0;

  y0 := LutTable[cell0];
  y1 := LutTable[cell1];

  y := y0 + (y1 - y0) * rest;

  result := iefloor(y + 0.5);
end;

procedure cmsEvalLUT(Lut: LPLUT; xIn: pwordarray; xOut: pwordarray);
var
  i: dword;
  StageABC, StageLMN: array[0..MAXCHANNELS - 1] of WORD;
  InVect, OutVect: WVEC3;
begin
  (*
  for i:=0 to Lut ^. InputChan-1 do
    StageABC[i] := xIn[i];

  if (Lut ^.wFlags and LUT_V4_OUTPUT_EMULATE_V2)<>0 then begin

    StageABC[0] := FROM_V2_TO_V4(StageABC[0]);
    StageABC[1] := FROM_V2_TO_V4(StageABC[1]);
    StageABC[2] := FROM_V2_TO_V4(StageABC[2]);

  end;

  if (Lut ^.wFlags and LUT_V2_OUTPUT_EMULATE_V4)<>0 then begin

      StageABC[0] := FROM_V4_TO_V2(StageABC[0]);
      StageABC[1] := FROM_V4_TO_V2(StageABC[1]);
      StageABC[2] := FROM_V4_TO_V2(StageABC[2]);
  end;

  if (Lut ^. wFlags and LUT_HASMATRIX)<>0 then begin

    InVect.n[VX] := ToFixedDomain(StageABC[0]);
    InVect.n[VY] := ToFixedDomain(StageABC[1]);
    InVect.n[VZ] := ToFixedDomain(StageABC[2]);

    MAT3evalW(@OutVect, @Lut ^. Matrix, @InVect);

    StageABC[0] := Clamp_RGB(FromFixedDomain(OutVect.n[VX]));
    StageABC[1] := Clamp_RGB(FromFixedDomain(OutVect.n[VY]));
    StageABC[2] := Clamp_RGB(FromFixedDomain(OutVect.n[VZ]));
  end;

  if (Lut ^. wFlags and LUT_HASTL1)<>0 then begin

    for i:=0 to Lut ^. InputChan-1 do
      StageABC[i] := cmsLinearInterpLUT16(StageABC[i],
                                                   PWordArray(Lut ^. L1[i]),
                                                   @Lut ^. In16params);
  end;

  if (Lut ^.wFlags and LUT_HASMATRIX3)<>0 then begin

    InVect.n[VX] := ToFixedDomain(StageABC[0]);
    InVect.n[VY] := ToFixedDomain(StageABC[1]);
    InVect.n[VZ] := ToFixedDomain(StageABC[2]);

    MAT3evalW(@OutVect, @Lut ^. Mat3, @InVect);

    OutVect.n[VX] := OutVect.n[VX] + Lut ^.Ofs3.n[VX];
    OutVect.n[VY] := OutVect.n[VY] + Lut ^.Ofs3.n[VY];
    OutVect.n[VZ] := OutVect.n[VZ] + Lut ^.Ofs3.n[VZ];

    StageABC[0] := Clamp_RGB(FromFixedDomain(OutVect.n[VX]));
    StageABC[1] := Clamp_RGB(FromFixedDomain(OutVect.n[VY]));
    StageABC[2] := Clamp_RGB(FromFixedDomain(OutVect.n[VZ]));

  end;

  if (Lut ^.wFlags and LUT_HASTL3)<>0 then begin

    for i:=0 to Lut ^. InputChan-1 do
      StageABC[i] := cmsLinearInterpLUT16(StageABC[i],
                                                   pwordarray(Lut ^. L3[i]),
                                                   @Lut ^. L3params);

  end;

  if (Lut ^. wFlags and LUT_HAS3DGRID)<>0 then begin

    Lut ^.CLut16params.Interp3D(@StageABC, @StageLMN, pwordarray(Lut ^. T), @Lut ^. CLut16params);

  end else begin

    for i:=0 to Lut ^. InputChan-1 do
      StageLMN[i] := StageABC[i];

  end;

  if (Lut ^.wFlags and LUT_HASTL4)<>0 then begin

    for i:=0 to Lut ^. OutputChan-1 do
      StageLMN[i] := cmsLinearInterpLUT16(StageLMN[i],
                                                   pwordarray(Lut ^. L4[i]),
                                                   @Lut ^. L4params);
  end;

  if (Lut ^.wFlags and LUT_HASMATRIX4)<>0 then begin

    InVect.n[VX] := ToFixedDomain(StageLMN[0]);
    InVect.n[VY] := ToFixedDomain(StageLMN[1]);
    InVect.n[VZ] := ToFixedDomain(StageLMN[2]);

    MAT3evalW(@OutVect, @Lut ^. Mat4, @InVect);

    OutVect.n[VX] := OutVect.n[VX]+ Lut ^.Ofs4.n[VX];
    OutVect.n[VY] := OutVect.n[VY]+ Lut ^.Ofs4.n[VY];
    OutVect.n[VZ] := OutVect.n[VZ]+ Lut ^.Ofs4.n[VZ];

    StageLMN[0] := Clamp_RGB(FromFixedDomain(OutVect.n[VX]));
    StageLMN[1] := Clamp_RGB(FromFixedDomain(OutVect.n[VY]));
    StageLMN[2] := Clamp_RGB(FromFixedDomain(OutVect.n[VZ]));

  end;

  if (Lut ^. wFlags and LUT_HASTL2)<>0 then begin

    for i:=0 to Lut ^. OutputChan-1 do
      xOut[i] := cmsLinearInterpLUT16(StageLMN[i],
                                                   pwordarray(Lut ^. L2[i]),
                                                   @Lut ^. Out16params);
  end else begin
    for i:=0 to Lut ^. OutputChan-1 do
      xOut[i] := StageLMN[i];
  end;

  if (Lut ^.wFlags and LUT_V4_INPUT_EMULATE_V2)<>0 then begin

      xOut[0] := FROM_V4_TO_V2(xOut[0]);
      xOut[1] := FROM_V4_TO_V2(xOut[1]);
      xOut[2] := FROM_V4_TO_V2(xOut[2]);

  end;

  if (Lut ^.wFlags and LUT_V2_INPUT_EMULATE_V4)<>0 then begin

      xOut[0] := FROM_V2_TO_V4(xOut[0]);
      xOut[1] := FROM_V2_TO_V4(xOut[1]);
      xOut[2] := FROM_V2_TO_V4(xOut[2]);
  end;
  *)
  with Lut^ do
  begin
    for i := 0 to InputChan - 1 do
      StageABC[i] := xIn[i];

    if (wFlags and LUT_V4_OUTPUT_EMULATE_V2) <> 0 then
    begin

      StageABC[0] := FROM_V2_TO_V4(StageABC[0]);
      StageABC[1] := FROM_V2_TO_V4(StageABC[1]);
      StageABC[2] := FROM_V2_TO_V4(StageABC[2]);

    end;

    if (wFlags and LUT_V2_OUTPUT_EMULATE_V4) <> 0 then
    begin

      StageABC[0] := FROM_V4_TO_V2(StageABC[0]);
      StageABC[1] := FROM_V4_TO_V2(StageABC[1]);
      StageABC[2] := FROM_V4_TO_V2(StageABC[2]);
    end;

    if (wFlags and LUT_HASMATRIX) <> 0 then
    begin

      InVect.n[VX] := ToFixedDomain(StageABC[0]);
      InVect.n[VY] := ToFixedDomain(StageABC[1]);
      InVect.n[VZ] := ToFixedDomain(StageABC[2]);

      MAT3evalW(@OutVect, @Matrix, @InVect);

      StageABC[0] := Clamp_RGB(FromFixedDomain(OutVect.n[VX]));
      StageABC[1] := Clamp_RGB(FromFixedDomain(OutVect.n[VY]));
      StageABC[2] := Clamp_RGB(FromFixedDomain(OutVect.n[VZ]));
    end;

    if (wFlags and LUT_HASTL1) <> 0 then
    begin

      for i := 0 to InputChan - 1 do
        StageABC[i] := cmsLinearInterpLUT16(StageABC[i],
          PWordArray(L1[i]),
          @In16params);
    end;

    if (wFlags and LUT_HASMATRIX3) <> 0 then
    begin

      InVect.n[VX] := ToFixedDomain(StageABC[0]);
      InVect.n[VY] := ToFixedDomain(StageABC[1]);
      InVect.n[VZ] := ToFixedDomain(StageABC[2]);

      MAT3evalW(@OutVect, @Mat3, @InVect);

      OutVect.n[VX] := OutVect.n[VX] + Ofs3.n[VX];
      OutVect.n[VY] := OutVect.n[VY] + Ofs3.n[VY];
      OutVect.n[VZ] := OutVect.n[VZ] + Ofs3.n[VZ];

      StageABC[0] := Clamp_RGB(FromFixedDomain(OutVect.n[VX]));
      StageABC[1] := Clamp_RGB(FromFixedDomain(OutVect.n[VY]));
      StageABC[2] := Clamp_RGB(FromFixedDomain(OutVect.n[VZ]));

    end;

    if (wFlags and LUT_HASTL3) <> 0 then
    begin

      for i := 0 to InputChan - 1 do
        StageABC[i] := cmsLinearInterpLUT16(StageABC[i],
          pwordarray(L3[i]),
          @L3params);

    end;

    if (wFlags and LUT_HAS3DGRID