ielcms.pas

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

  TagCount, i: icInt32Number;
begin
  result := nil;
  Icc := ICCAllocStruct(Read, Seek, Tell, Close);
  if (Icc = nil) then
  begin
    result := nil;
    exit;
  end;

  Icc^.stream := ICCfile;
  Icc^.Read(@Header, sizeof(icHeader), 1, ICCfile);

  AdjustEndianess32(@Header.size);
  AdjustEndianess32(@Header.cmmId);
  AdjustEndianess32(@Header.version);
  AdjustEndianess32(@Header.deviceClass);
  AdjustEndianess32(@Header.colorSpace);
  AdjustEndianess32(@Header.pcs);
  AdjustEndianess32(@Header.magic);
  AdjustEndianess32(@Header.flags);
  AdjustEndianess32(@Header.renderingIntent);

  try
    if (Header.magic <> icMagicNumber) then
      exit;
    if (Icc^.Read(@TagCount, sizeof(icInt32Number), 1, ICCfile) <> 1) then
      exit;

    AdjustEndianess32(@TagCount);

    Icc^.DeviceClass := Header.deviceClass;
    Icc^.ColorSpace := Header.colorSpace;
    Icc^.PCS := Header.pcs;
    Icc^.RenderingIntent := icRenderingIntent(Header.renderingIntent);
    Icc^.flags := Header.flags;
    Icc^.Illuminant.X := Convert15Fixed16(Header.illuminant.X);
    Icc^.Illuminant.Y := Convert15Fixed16(Header.illuminant.Y);
    Icc^.Illuminant.Z := Convert15Fixed16(Header.illuminant.Z);
    Icc^.Version := Header.version;

    Icc^.Illuminant := cmsD50_XYZ^;

    CopyMemory(@Icc^.ProfileID[0], @Header.reserved[0], 16);

    NormalizeXYZ(@Icc^.Illuminant);

    Icc^.TagCount := TagCount;
    for i := 0 to TagCount - 1 do
    begin
      Icc^.Read(@Tag, sizeof(icTag), 1, ICCfile);

      AdjustEndianess32(@Tag.offset);
      AdjustEndianess32(@Tag.size);
      AdjustEndianess32(@Tag.sig);

      Icc^.TagNames[i] := Tag.sig;
      Icc^.TagOffsets[i] := Tag.offset;
      Icc^.TagSizes[i] := Tag.size;
    end;

    result := Icc;

  finally
    if result = nil then
    begin
      Icc^.Close(ICCfile);
      freemem(Icc);
    end;
  end;
end;

// Does search for a specific tag in tag dictionary
// Returns position or -1 if tag not found

function SearchTag(Profile: LPLCMSICCPROFILE; sig: icTagSignature): icInt32Number;
var
  i: icInt32Number;
begin
  if (integer(sig) = 0) then
  begin
    result := -1;
    exit;
  end;

  for i := 0 to Profile^.TagCount - 1 do
  begin
    if (sig = Profile^.TagNames[i]) then
    begin
      result := i;
      exit;
    end;
  end;

  result := -1;
end;

function ReadICCXYZ(hProfile: cmsHPROFILE; sig: icTagSignature; Value: LPcmsCIEXYZ; lIsFatal: longbool): integer;
var
  Icc: LPLCMSICCPROFILE;
  Base: icTagBase;
  offset: integer;
  n: integer;
  XYZ: icXYZNumber;
begin
  Icc := LPLCMSICCPROFILE(hProfile);

  n := SearchTag(Icc, sig);
  if (n < 0) then
  begin
    result := -1;
    exit;
  end;

  if (Icc^.stream = nil) then
  begin
    CopyMemory(Value, Icc^.TagPtrs[n], Icc^.TagSizes[n]);
    result := Icc^.TagSizes[n];
    exit;
  end;

  offset := Icc^.TagOffsets[n];

  if (Icc^.Seek(Icc^.stream, offset)) then
  begin
    result := -1;
    exit;
  end;

  Icc^.Read(@Base, 1, sizeof(icTagBase), Icc^.stream);
  AdjustEndianess32(@Base.sig);

  case Base.sig of
    icTagTypeSignature($7C3B10C),
      icSigXYZType:
      begin
        Icc^.Read(@XYZ, sizeof(icXYZNumber), 1, Icc^.stream);
        Value^.X := Convert15Fixed16(XYZ.X);
        Value^.Y := Convert15Fixed16(XYZ.Y);
        Value^.Z := Convert15Fixed16(XYZ.Z);
      end;
  else
    if (lIsFatal) then
    begin
      //raise Exception.Create('Bad tag signature '+inttostr(Base.sig)+' found.');
      result := -1;
      exit;
    end;
  end;
  result := 1;
end;

// Read a icSigS15Fixed16ArrayType (currently only a 3x3 matrix)

function ReadICCXYZArray(hProfile: cmsHPROFILE; sig: icTagSignature; v: LPMAT3): integer;
var
  Icc: LPLCMSICCPROFILE;
  Base: icTagBase;
  offset, sz: integer;
  i, n: integer;
  XYZ: array[0..2] of icXYZNumber;
  XYZdbl: array[0..2] of cmsCIEXYZ;
begin
  Icc := LPLCMSICCPROFILE(hProfile);

  n := SearchTag(Icc, sig);
  if (n < 0) then
  begin
    result := -1;
    exit;
  end;

  if (Icc^.stream = nil) then
  begin

    CopyMemory(v, Icc^.TagPtrs[n], Icc^.TagSizes[n]);

    result := Icc^.TagSizes[n];
    exit;
  end;

  offset := Icc^.TagOffsets[n];

  if (Icc^.Seek(Icc^.stream, offset)) then
  begin
    result := -1;
    exit;
  end;

  Icc^.Read(@Base, 1, sizeof(icTagBase), Icc^.stream);
  AdjustEndianess32(@Base.sig);

  case (Base.sig) of

    icSigS15Fixed16ArrayType:
      begin

        sz := Icc^.TagSizes[n] div sizeof(icXYZNumber);

        if (sz <> 3) then
        begin
          //cmsSignalError(LCMS_ERRC_ABORTED, "Bad array size of %d entries.", sz);
          result := -1;
          exit;
        end;

        Icc^.Read(@XYZ[0], sizeof(icXYZNumber), 3, Icc^.stream);

        for i := 0 to 2 do
        begin

          XYZdbl[i].X := Convert15Fixed16(XYZ[i].X);
          XYZdbl[i].Y := Convert15Fixed16(XYZ[i].Y);
          XYZdbl[i].Z := Convert15Fixed16(XYZ[i].Z);
        end;

        CopyMemory(v, @XYZdbl[0], 3 * sizeof(cmsCIEXYZ));
      end;

  else
    begin
      //cmsSignalError(LCMS_ERRC_ABORTED, "Bad tag signature %lx found.", Base.sig);
      result := -1;
      exit;
    end;

  end;

  result := sizeof(MAT3);
end;

// linear transform

procedure MAT3eval(r: LPVEC3; a: LPMAT3; v: LPVEC3);
begin
  r^.n[VX] := a^.v[0].n[VX] * v^.n[VX] + a^.v[0].n[VY] * v^.n[VY] + a^.v[0].n[VZ] * v^.n[VZ];
  r^.n[VY] := a^.v[1].n[VX] * v^.n[VX] + a^.v[1].n[VY] * v^.n[VY] + a^.v[1].n[VZ] * v^.n[VZ];
  r^.n[VZ] := a^.v[2].n[VX] * v^.n[VX] + a^.v[2].n[VY] * v^.n[VY] + a^.v[2].n[VZ] * v^.n[VZ];
end;

// Evaluates a XYZ tristimulous across chromatic adaptation matrix

procedure EvalCHRM(Dest: LPcmsCIEXYZ; Chrm: LPMAT3; Src: LPcmsCIEXYZ);
var
  d, s: VEC3;
begin
  s.n[VX] := Src^.X;
  s.n[VY] := Src^.Y;
  s.n[VZ] := Src^.Z;

  MAT3eval(@d, Chrm, @s);

  Dest^.X := d.n[VX];
  Dest^.Y := d.n[VY];
  Dest^.Z := d.n[VZ];
end;

function ROWCOL(a,b:LPMAT3; i, j: integer): double; {$ifdef IESUPPORTINLINE} inline; {$endif}
begin
  result := a^.v[i].n[0] * b^.v[0].n[j] + a^.v[i].n[1] * b^.v[1].n[j] + a^.v[i].n[2] * b^.v[2].n[j]
end;

// Multiply two matrices

procedure MAT3per(r: LPMAT3; a: LPMAT3; b: LPMAT3);
begin
  VEC3init(@r^.v[0], ROWCOL(a,b,0, 0), ROWCOL(a,b,0, 1), ROWCOL(a,b,0, 2));
  VEC3init(@r^.v[1], ROWCOL(a,b,1, 0), ROWCOL(a,b,1, 1), ROWCOL(a,b,1, 2));
  VEC3init(@r^.v[2], ROWCOL(a,b,2, 0), ROWCOL(a,b,2, 1), ROWCOL(a,b,2, 2));
  (*
  with a^.v[0] do
    VEC3init(@r^.v[0], n[0] * b^.v[0].n[0] + n[1] * b^.v[1].n[0] + n[2] * b^.v[2].n[0],
                       n[0] * b^.v[0].n[1] + n[1] * b^.v[1].n[1] + n[2] * b^.v[2].n[1],
                       n[0] * b^.v[0].n[2] + n[1] * b^.v[1].n[2] + n[2] * b^.v[2].n[2]);
  with a^.v[1] do
    VEC3init(@r^.v[1], n[0] * b^.v[0].n[0] + n[1] * b^.v[1].n[0] + n[2] * b^.v[2].n[0],
                       n[0] * b^.v[0].n[1] + n[1] * b^.v[1].n[1] + n[2] * b^.v[2].n[1],
                       n[0] * b^.v[0].n[2] + n[1] * b^.v[1].n[2] + n[2] * b^.v[2].n[2]);
  with a^.v[2] do
    VEC3init(@r^.v[2], n[0] * b^.v[0].n[0] + n[1] * b^.v[1].n[0] + n[2] * b^.v[2].n[0],
                       n[0] * b^.v[0].n[1] + n[1] * b^.v[1].n[1] + n[2] * b^.v[2].n[1],
                       n[0] * b^.v[0].n[2] + n[1] * b^.v[1].n[2] + n[2] * b^.v[2].n[2]);
                       *)
end;

// Compute chromatic adaptation matrix using Chad as cone matrix

procedure ComputeChromaticAdaptation(Conversion: LPMAT3; SourceWhitePoint: LPcmsCIEXYZ; DestWhitePoint: LPcmsCIEXYZ; Chad: LPMAT3);
var
  Chad_Inv: MAT3;
  ConeSourceXYZ, ConeSourceRGB: VEC3;
  ConeDestXYZ, ConeDestRGB: VEC3;
  Cone, Tmp: MAT3;
begin
  Tmp := Chad^;
  MAT3inverse(@Tmp, @Chad_Inv);

  VEC3init(@ConeSourceXYZ, SourceWhitePoint^.X,
    SourceWhitePoint^.Y,
    SourceWhitePoint^.Z);

  VEC3init(@ConeDestXYZ, DestWhitePoint^.X,
    DestWhitePoint^.Y,
    DestWhitePoint^.Z);

  MAT3eval(@ConeSourceRGB, Chad, @ConeSourceXYZ);
  MAT3eval(@ConeDestRGB, Chad, @ConeDestXYZ);

  VEC3init(@Cone.v[0], ConeDestRGB.n[0] / ConeSourceRGB.n[0], 0.0, 0.0);
  VEC3init(@Cone.v[1], 0.0, ConeDestRGB.n[1] / ConeSourceRGB.n[1], 0.0);
  VEC3init(@Cone.v[2], 0.0, 0.0, ConeDestRGB.n[2] / ConeSourceRGB.n[2]);

  MAT3per(@Tmp, @Cone, Chad);
  MAT3per(Conversion, @Chad_Inv, @Tmp);
end;

// Returns the final chrmatic adaptation from illuminant FromIll to Illuminant ToIll
// The cone matrix can be specified in ConeMatrix. If NULL, Bradford is assumed

function cmsAdaptationMatrix(r: LPMAT3; ConeMatrix: LPMAT3; FromIll: LPcmsCIEXYZ; ToIll: LPcmsCIEXYZ): longbool;
const
  LamRigg: MAT3 = (
    v: ((n: (0.8951, 0.2664, -0.1614)),
    (n: (-0.7502, 1.7135, 0.0367)),
    (n: (0.0389, -0.0685, 1.0296)))
    );
begin
  if (ConeMatrix = nil) then
    ConeMatrix := @LamRigg;
  ComputeChromaticAdaptation(r, FromIll, ToIll, ConeMatrix);
  result := true;
end;

procedure ReadCriticalTags(Icc: LPLCMSICCPROFILE);
const
  Brfd: MAT3 = (
    v: ((n: (0.8951, 0.2664, -0.1614)),
    (n: (-0.7502, 1.7135, 0.0367)),
    (n: (0.0389, -0.0685, 1.0296)))
    );
var
  hProfile: cmsHPROFILE;
  ChrmCanonical: MAT3;
begin
  hProfile := cmsHPROFILE(Icc);

  if (Icc^.Version >= $4000000) then
  begin
    if (ReadICCXYZ(hProfile, icSigMediaWhitePointTag, @Icc^.MediaWhitePoint, FALSE) < 0) then
    begin
      Icc^.MediaWhitePoint := cmsD50_XYZ()^;
    end;

    if (ReadICCXYZ(hProfile, icSigMediaBlackPointTag, @Icc^.MediaBlackPoint, FALSE) < 0) then
    begin
      Icc^.MediaBlackPoint.X := 0;
      Icc^.MediaBlackPoint.Y := 0;
      Icc^.MediaBlackPoint.X := 0;
    end;

    NormalizeXYZ(@Icc^.MediaWhitePoint);
    NormalizeXYZ(@Icc^.MediaBlackPoint);

    if (ReadICCXYZArray(hProfile, icTagSignature(icSigChromaticAdaptationTag), @ChrmCanonical) > 0) then
    begin
      MAT3inverse(@ChrmCanonical, @Icc^.ChromaticAdaptation);
    end
    else
    begin
      MAT3identity(@Icc^.ChromaticAdaptation);
    end;

    EvalCHRM(@Icc^.MediaWhitePoint, @Icc^.ChromaticAdaptation, @Icc^.MediaWhitePoint);
    EvalCHRM(@Icc^.MediaBlackPoint, @Icc^.ChromaticAdaptation, @Icc^.MediaBlackPoint);

  end
  else
  begin

    if (ReadICCXYZ(hProfile, icSigMediaWhitePointTag, @Icc^.MediaWhitePoint, FALSE) < 0) then
    begin
      Icc^.MediaWhitePoint := cmsD50_XYZ()^;
    end;

    if (ReadICCXYZ(hProfile, icSigMediaBlackPointTag, @Icc^.MediaBlackPoint, FALSE) < 0) then
    begin
      Icc^.MediaBlackPoint.X := 0;
      Icc^.MediaBlackPoint.Y := 0;
      Icc^.MediaBlackPoint.X := 0;
    end;

    NormalizeXYZ(@Icc^.MediaWhitePoint);
    NormalizeXYZ(@Icc^.MediaBlackPoint);

    cmsAdaptationMatrix(@Icc^.ChromaticAdaptation, @Brfd, @Icc^.Illuminant, @Icc^.MediaWhitePoint);

  end;

end;

// Create profile from disk file

function IEcmsOpenProfileFromFile(stream: TStream; save: boolean; save8bit: boolean): cmsHPROFILE;
var
  NewIcc: LPLCMSICCPROFILE;
  hEmpty: cmsHPROFILE;
begin

  if save then
  begin

    hEmpty := _cmsCreateProfilePlaceholder();
    NewIcc := LPLCMSICCPROFILE(hEmpty);
    NewIcc^.IsWrite := TRUE;
    NewIcc^.PhysicalFile := stream;

    if save8bit then
      NewIcc^.SaveAs8Bits := TRUE;
    result := hEmpty;
    exit;
  end;

  NewIcc := CreateICCProfileHandler(stream, IEFileRead, IEFileSeek, IEFileTell, IEFileClose);
  if (NewIcc = nil) then
  begin
    result := nil;
    exit;
    //raise Exception.Create('Corrupted profile');
  end;

  ReadCriticalTags(NewIcc);

  NewIcc^.PhysicalFile := stream;
  NewIcc^.IsWrite := FALSE;
  result := cmsHPROFILE(NewIcc);
end;

// Auxiliary: allocate transform struct and set to defaults