AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi How to apply color profiles to produce real color?

How to apply color profiles to produce real color?

Ein Thema von WojTec · begonnen am 23. Feb 2012 · letzter Beitrag vom 4. Mär 2012
Antwort Antwort
WojTec

Registriert seit: 17. Mai 2007
480 Beiträge
 
Delphi XE6 Professional
 
#1

How to apply color profiles to produce real color?

  Alt 23. Feb 2012, 15:49
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;
  Mit Zitat antworten Zitat
freeway

Registriert seit: 11. Jul 2009
57 Beiträge
 
Delphi XE Professional
 
#2

AW: How to apply color profiles to produce real color?

  Alt 23. Feb 2012, 21:43
your sample code convert a RGB profile to a CMKY profile not even more

>How to apply color profiles to produce real color
FFFF00 + profile = RGB(255, 242, 0)
well, a icc profile reduce your colorspace at least
  Mit Zitat antworten Zitat
WojTec

Registriert seit: 17. Mai 2007
480 Beiträge
 
Delphi XE6 Professional
 
#3

Re: How to apply color profiles to produce real color?

  Alt 24. Feb 2012, 09:21
Ok, but should be here:

{ Input }, { Output } cmsDoTransform() is waiting for pointer to bitmap, if I see well in manual, I don't understand how to use it for simple color?
  Mit Zitat antworten Zitat
freeway

Registriert seit: 11. Jul 2009
57 Beiträge
 
Delphi XE Professional
 
#4

AW: How to apply color profiles to produce real color?

  Alt 24. Feb 2012, 12:14
create a 1x1 bitmap
set this pixel to a single color
  Mit Zitat antworten Zitat
WojTec

Registriert seit: 17. Mai 2007
480 Beiträge
 
Delphi XE6 Professional
 
#5

Re: How to apply color profiles to produce real color?

  Alt 1. Mär 2012, 09:57
Ok, I did it with 1x1 bitmap and finally I got this:

Delphi-Quellcode:
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;
So, this should convert RGB to CMYK (here monitor RGB to paint CMYK) - I selected from list sRGB IEC6 1966-2.1 for RGB and US Web Coated (SWOP) v2 for CMYK. I expect CMYK red, but I got RGB red (same as input). What I'm doing wrong?
  Mit Zitat antworten Zitat
freeway

Registriert seit: 11. Jul 2009
57 Beiträge
 
Delphi XE Professional
 
#6

AW: How to apply color profiles to produce real color?

  Alt 4. Mär 2012, 06:05
you create OutColor := CreateBitmap but where did you create Incolor ?

PS don´t forgot to release your created bitmaps

Geändert von freeway ( 4. Mär 2012 um 06:09 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:56 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz