323 lines
7.4 KiB
ObjectPascal
323 lines
7.4 KiB
ObjectPascal
unit demo1;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
ExtCtrls, StdCtrls, ExtDlgs, lcms2dll, ComCtrls;
|
|
|
|
type
|
|
TForm1 = class(TForm)
|
|
|
|
Image1: TImage;
|
|
Image2: TImage;
|
|
Panel1: TPanel;
|
|
Splitter1: TSplitter;
|
|
Button2: TButton;
|
|
ComboBoxInput: TComboBox;
|
|
ComboBoxOutput: TComboBox;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
WBCompensation: TCheckBox;
|
|
NoTransform: TCheckBox;
|
|
RadioGroup1: TRadioGroup;
|
|
OpenPictureDialog1: TOpenPictureDialog;
|
|
Button1: TButton;
|
|
ProgressBar1: TProgressBar;
|
|
ComboBoxIntent: TComboBox;
|
|
Label3: TLabel;
|
|
Button3: TButton;
|
|
Button4: TButton;
|
|
OpenDialog1: TOpenDialog;
|
|
Label4: TLabel;
|
|
ScrollBar1: TScrollBar;
|
|
|
|
procedure Button2Click(Sender: TObject);
|
|
procedure Button1Click(Sender: TObject);
|
|
procedure Button3Click(Sender: TObject);
|
|
procedure Button4Click(Sender: TObject);
|
|
procedure ComboBoxIntentChange(Sender: TObject);
|
|
procedure ScrollBar1Change(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
function ComputeFlags: DWORD;
|
|
|
|
public
|
|
constructor Create(Owner: TComponent); Override;
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
Form1: TForm1;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
CONST
|
|
IS_INPUT = $1;
|
|
IS_DISPLAY = $2;
|
|
IS_COLORSPACE = $4;
|
|
IS_OUTPUT = $8;
|
|
IS_ABSTRACT = $10;
|
|
|
|
VAR
|
|
IntentCodes: array [0 .. 20] of cmsUInt32Number;
|
|
|
|
FUNCTION InSignatures(Signature: cmsProfileClassSignature; dwFlags: DWORD): Boolean;
|
|
BEGIN
|
|
|
|
if (((dwFlags AND IS_DISPLAY) <> 0) AND (Signature = cmsSigDisplayClass)) then
|
|
InSignatures := TRUE
|
|
else if (((dwFlags AND IS_OUTPUT) <> 0) AND (Signature = cmsSigOutputClass))
|
|
then
|
|
InSignatures := TRUE
|
|
else if (((dwFlags AND IS_INPUT) <> 0) AND (Signature = cmsSigInputClass))
|
|
then
|
|
InSignatures := TRUE
|
|
else if (((dwFlags AND IS_COLORSPACE) <> 0) AND
|
|
(Signature = cmsSigColorSpaceClass)) then
|
|
InSignatures := TRUE
|
|
else if (((dwFlags AND IS_ABSTRACT) <> 0) AND
|
|
(Signature = cmsSigAbstractClass)) then
|
|
InSignatures := TRUE
|
|
else
|
|
InSignatures := FALSE
|
|
END;
|
|
|
|
PROCEDURE FillCombo(var Combo: TComboBox; Signatures: DWORD);
|
|
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);
|
|
while Found = 0 do
|
|
begin
|
|
Profile := Path + SearchRec.Name;
|
|
hProfile := cmsOpenProfileFromFile(PAnsiChar(AnsiString(Profile)), 'r');
|
|
if (hProfile <> NIL) THEN
|
|
begin
|
|
|
|
if ((cmsGetColorSpace(hProfile) = cmsSigRgbData) AND InSignatures
|
|
(cmsGetDeviceClass(hProfile), Signatures)) then
|
|
begin
|
|
cmsGetProfileInfo(hProfile, cmsInfoDescription, 'EN', 'us', Descrip,
|
|
256);
|
|
Descriptions.Add(Descrip);
|
|
Files.Add(Profile);
|
|
end;
|
|
cmsCloseProfile(hProfile);
|
|
end;
|
|
|
|
Found := FindNext(SearchRec);
|
|
|
|
end;
|
|
FindClose(SearchRec);
|
|
Combo.Items := Descriptions;
|
|
Combo.Tag := Integer(Files);
|
|
end;
|
|
|
|
// A rather simple Logger... note the "cdecl" convention
|
|
PROCEDURE ErrorLogger(ContextID: cmsContext; ErrorCode: cmsUInt32Number;
|
|
Text: PAnsiChar); Cdecl;
|
|
begin
|
|
MessageBox(0, PWideChar(WideString(Text)), 'Something is going wrong...',
|
|
MB_OK OR MB_ICONWARNING or MB_TASKMODAL);
|
|
end;
|
|
|
|
constructor TForm1.Create(Owner: TComponent);
|
|
var
|
|
IntentNames: array [0 .. 20] of PAnsiChar;
|
|
i, n: Integer;
|
|
begin
|
|
inherited Create(Owner);
|
|
|
|
// Set the logger
|
|
cmsSetLogErrorHandler(ErrorLogger);
|
|
|
|
ScrollBar1.Min := 0;
|
|
ScrollBar1.Max := 100;
|
|
|
|
FillCombo(ComboBoxInput, IS_INPUT OR IS_COLORSPACE OR IS_DISPLAY);
|
|
FillCombo(ComboBoxOutput, $FFFF );
|
|
|
|
|
|
// Get the supported intents
|
|
n := cmsGetSupportedIntents(20, @IntentCodes, @IntentNames);
|
|
|
|
|
|
ComboBoxIntent.Items.BeginUpdate;
|
|
ComboBoxIntent.Items.Clear;
|
|
for i:= 0 TO n - 1 DO
|
|
ComboBoxIntent.Items.Add(String(IntentNames[i]));
|
|
|
|
ComboBoxIntent.ItemIndex := 0;
|
|
ComboBoxIntent.Items.EndUpdate;
|
|
end;
|
|
|
|
|
|
|
|
procedure TForm1.ScrollBar1Change(Sender: TObject);
|
|
var d: Integer;
|
|
s: String;
|
|
begin
|
|
d := ScrollBar1.Position;
|
|
Str(d, s);
|
|
Label4.Caption := 'Adaptation state '+s + '% (Abs. col only)';
|
|
end;
|
|
|
|
procedure TForm1.Button2Click(Sender: TObject);
|
|
begin
|
|
if OpenPictureDialog1.Execute then
|
|
begin
|
|
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
|
|
Image1.Picture.Bitmap.PixelFormat := pf24bit;
|
|
|
|
Image2.Picture.LoadFromFile(OpenPictureDialog1.FileName);
|
|
Image2.Picture.Bitmap.PixelFormat := pf24bit;
|
|
|
|
end
|
|
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 TForm1.ComboBoxIntentChange(Sender: TObject);
|
|
begin
|
|
ScrollBar1.Enabled := (ComboBoxIntent.itemIndex = 3);
|
|
end;
|
|
|
|
function TForm1.ComputeFlags: DWORD;
|
|
var
|
|
dwFlags: DWORD;
|
|
begin
|
|
dwFlags := 0;
|
|
if (WBCompensation.Checked) then
|
|
begin
|
|
dwFlags := dwFlags OR cmsFLAGS_BLACKPOINTCOMPENSATION
|
|
end;
|
|
|
|
if (NoTransform.Checked) then
|
|
begin
|
|
dwFlags := dwFlags OR cmsFLAGS_NULLTRANSFORM
|
|
end;
|
|
|
|
case RadioGroup1.ItemIndex of
|
|
0:
|
|
dwFlags := dwFlags OR cmsFLAGS_NOOPTIMIZE;
|
|
1:
|
|
dwFlags := dwFlags OR cmsFLAGS_HIGHRESPRECALC;
|
|
3:
|
|
dwFlags := dwFlags OR cmsFLAGS_LOWRESPRECALC;
|
|
end;
|
|
|
|
ComputeFlags := dwFlags
|
|
end;
|
|
|
|
procedure TForm1.Button1Click(Sender: TObject);
|
|
var
|
|
Source, Dest: String;
|
|
hSrc, hDest: cmsHPROFILE;
|
|
xform: cmsHTRANSFORM;
|
|
i, PicW, PicH: Integer;
|
|
Intent: Integer;
|
|
dwFlags: DWORD;
|
|
begin
|
|
|
|
Source := SelectedFile(ComboBoxInput);
|
|
Dest := SelectedFile(ComboBoxOutput);
|
|
|
|
dwFlags := ComputeFlags;
|
|
|
|
Intent := IntentCodes[ComboBoxIntent.ItemIndex];
|
|
|
|
cmsSetAdaptationState( ScrollBar1.Position / 100.0 );
|
|
|
|
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
|
|
|
|
PicW := Image2.Picture.width;
|
|
PicH := Image2.Picture.height;
|
|
ProgressBar1.Min := 0;
|
|
ProgressBar1.Max := PicH;
|
|
ProgressBar1.Step := 1;
|
|
|
|
for i := 0 TO (PicH - 1) do
|
|
begin
|
|
if ((i MOD 100) = 0) then
|
|
ProgressBar1.Position := i;
|
|
|
|
cmsDoTransform(xform, Image1.Picture.Bitmap.Scanline[i],
|
|
Image2.Picture.Bitmap.Scanline[i], PicW);
|
|
|
|
end;
|
|
ProgressBar1.Position := PicH;
|
|
|
|
cmsDeleteTransform(xform);
|
|
|
|
end;
|
|
|
|
Image2.Repaint;
|
|
ProgressBar1.Position := 0;
|
|
end
|
|
end;
|
|
|
|
procedure TForm1.Button3Click(Sender: TObject);
|
|
begin
|
|
if OpenDialog1.Execute then
|
|
ComboBoxInput.Text := OpenDialog1.FileName;
|
|
end;
|
|
|
|
procedure TForm1.Button4Click(Sender: TObject);
|
|
begin
|
|
if OpenDialog1.Execute then
|
|
ComboBoxOutput.Text := OpenDialog1.FileName;
|
|
end;
|
|
|
|
end.
|