How to apply color profiles to produce real color?

[WojTec]

I'm trying get color like in Photoshop. For example for CMYK(0, 0, 100, 0) get RGB(255, 242, 0) instead FFFF00. Based on demo which is not clear for me I got something like this and don't know what next:

Delphi-Quellcode:

var
  IntentCodes: array [0..20] of cmsUInt32Number;

procedure GetProfiles(var ACombo: TComboBox; const AColorSpace: cmsColorSpaceSignature);
var
  Files, Descriptions: TStringList;
  Found: Integer;
  SearchRec: TSearchRec;
  Path, Profile: string;
  Dir: array [0..1024] of Char;
  hProfile: cmsHPROFILE;
  Descrip: array [0..256] of Char;
begin
  Files := TStringList.Create;
  Descriptions := TStringList.Create;
  GetSystemDirectory(Dir, 1023);
  Path := string(Dir) + '\spool\drivers\color\';

  Found := FindFirst(Path + '*.ic?', faAnyFile, SearchRec);
  try
    while Found = 0 do
    begin
      Profile := Path + SearchRec.Name;
      hProfile := cmsOpenProfileFromFile(PAnsiChar(AnsiString(Profile)), 'r');
      if (hProfile <> nil) then
      begin
        if (cmsGetColorSpace(hProfile) = AColorSpace) then
        begin
          cmsGetProfileInfo(hProfile, cmsInfoDescription, 'EN', 'us', Descrip, 256);
          Descriptions.Add(Descrip);
          Files.Add(Profile);
        end;
        cmsCloseProfile(hProfile);
      end;

      Found := FindNext(SearchRec);
    end;
  finally
    FindClose(SearchRec);
  end;

  ACombo.Items := Descriptions;
  ACombo.Tag := Integer(Files);
end;

function SelectedFile(var Combo: TComboBox): string;
var
  List: TStringList;
  n: Integer;
begin

  List := TStringList(Combo.Tag);
  n := Combo.ItemIndex;
  if (n >= 0) then
    SelectedFile := List.Strings[n]
  else
    SelectedFile := Combo.Text;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  Source, Dest: string;
  hSrc, hDest: cmsHPROFILE;
  xform: cmsHTRANSFORM;
  i, PicW, PicH: Integer;
  Intent: Integer;
  dwFlags: DWORD;
begin

  Source := SelectedFile(cbRGBProfiles);
  Dest := SelectedFile(cbCMYKProfiles);

  if cbCompensation.Checked then
    dwFlags := cmsFLAGS_BLACKPOINTCOMPENSATION
  else
    dwFlags := 0
  ;

  Intent := IntentCodes[cbIntents.ItemIndex];

  //cmsSetAdaptationState(cmsSetAdaptationState(-1));

  if (Source <> '') and (Dest <> '') then
  begin
    hSrc := cmsOpenProfileFromFile(PAnsiChar(AnsiString(Source)), 'r');
    hDest := cmsOpenProfileFromFile(PAnsiChar(AnsiString(Dest)), 'r');

    if (hSrc <> nil) and (hDest <> Nil) then
    begin
      xform := cmsCreateTransform(hSrc, TYPE_BGR_8, hDest, TYPE_BGR_8, Intent,
        dwFlags);
    end
    else
    begin
      xform := nil;
    end;

    if hSrc <> nil then
    begin
      cmsCloseProfile(hSrc);
    end;

    if hDest <> nil then
    begin
      cmsCloseProfile(hDest);
    end;

    if (xform <> nil) then
    begin
      cmsDoTransform(xform, { Input }, { Output }, 1);

      cmsDeleteTransform(xform);

    end;
  end
end;

procedure TForm2.FormCreate(Sender: TObject);
var
  IntentNames: array [0..20] of PAnsiChar;
  I, Count: Integer;
begin
  GetProfiles(cbRGBProfiles, cmsSigRgbData);
  GetProfiles(cbCMYKProfiles, cmsSigCmykData);

  Count := cmsGetSupportedIntents(20, @IntentCodes, @IntentNames);

  cbIntents.Items.BeginUpdate;
  for I := 0 to Count - 1 DO
    cbIntents.Items.Add(string(IntentNames[I]));

  cbIntents.ItemIndex := 0;
  cbIntents.Items.EndUpdate;
end;