SIPC
Scanner ICC Profile Creator


SOURCE CODE


program sipc;

uses
Forms,
Unit1 in 'Unit1.pas' {Form1},
Unit2 in 'Unit2.pas' {Form2},
Unit3 in 'Unit3.pas' {Form3},
CheckPrevious in 'CheckPrevious.pas';

{$R *.res}

begin
if not CheckPrevious.RestoreIfRunning(Application.Handle) then
begin
Application.Initialize;
Application.Title := 'SIPC';
Application.HelpFile := 'SIPC.HLP';
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm3, Form3);
Application.Run;
end;
end.


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, PJShellFolders, ExtCtrls,
ExtDlgs, ShellAPI, INIFILES, registry, ieview, imageenview, ieopensavedlg,
jpeg, janWebLabel, xpButton, ComCtrls, AutoUpgrader;

type
TForm1 = class(TForm)
PJDlg1: TPJBrowseDialog;
Panel1: TPanel;
Panel4: TPanel;
scanner_edit: TLabeledEdit;
descr_edit: TLabeledEdit;
copy_edit: TLabeledEdit;
model_edit: TLabeledEdit;
RadioGroup1: TRadioGroup;
SaveDialog1: TSaveDialog;
Image3: TImage;
Image4: TImage;
RadioGroup2: TRadioGroup;
Image5: TImage;
OpenDialog1: TOpenImageEnDialog;
Panel5: TPanel;
RefLabel: TLabel;
ImgLabel: TLabel;
Image6: TImage;
Panel2: TPanel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
OpenDialog2: TOpenDialog;
Panel7: TPanel;
image1: TImageEnView;
Bevel3: TBevel;
Label6: TLabel;
Panel3: TPanel;
janWebLabel1: TjanWebLabel;
Image2: TImage;
Image7: TImage;
Label1: TLabel;
Image8: TImage;
TargetBtn: TxpButton;
CaptureBtn: TxpButton;
ReferenceBtn: TxpButton;
InstrBtn: TxpButton;
HelpBtn: TxpButton;
CropBtn: TxpButton;
ExitBtn: TxpButton;
CreateBtn: TxpButton;
Image9: TImage;
upg1: TAutoUpgrader;
VerBtn: TxpButton;
Panel6: TPanel;
ProgressLabel: TLabel;
ProgressBar1: TProgressBar;
xpButton1: TxpButton;
procedure TargetBtnClick(Sender: TObject);
procedure RefrenceBtnClick(Sender: TObject);
procedure ExitBtnClick(Sender: TObject);
procedure CreateBtnClick(Sender: TObject);
procedure Proc_run(ProgramName : String; Wait: Boolean);
procedure FormCreate(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
function FileDeleteRB(AFileName:string): boolean;
procedure InstrBtnClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure reg_change(Sender: TObject) ;
function FindWin: string;
procedure CaptureBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure CropbtnClick(Sender: TObject);
procedure image1SelectionChange(Sender: TObject);
procedure image1DblClick(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure VerBtnClick(Sender: TObject);
procedure upg1Progress(Sender: TObject; TotalSize, ReadSize,
ReadPercents: Integer);
procedure upg1Done(Sender: TObject; FileSize: Integer);
procedure upg1NoUpdateAvailable(Sender: TObject);
procedure upg1Error(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
icc_file, ref_file, out_file, tar_dir, ref_dir, prof_dir,
scanner, model, descr, copyright: string;
m, alg: string[1];
btn_flag, temp_img: boolean;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.TargetBtnClick(Sender: TObject);
begin
OpenDialog1.Filter:= 'TIFF images (*.tif; *.tiff)|*.tif;*.tiff';
OPenDIalog1.InitialDir:=tar_dir;
OpenDialog1.FileName:='';
If OpenDialog1.Execute then
begin
icc_file:= OpenDialog1.FileName;
tar_dir:= ExtractFilePath(OpenDialog1.FileName);
try
Image1.IO.LoadFromFile(OpenDialog1.FileName);
except
Image1.Blank;
end;
end
else
Image1.Blank;
ImgLabel.Caption:= ExtractFileName(OpenDialog1.FileName);
end;

procedure TForm1.RefrenceBtnClick(Sender: TObject);
begin
OpenDialog2.Filter:= 'Reference Files (*.txt; *q60)|*.txt; *.q60';
OpenDialog2.InitialDir:= ref_dir;
OpenDialog2.FileName:='';
If OpenDialog2.Execute then
begin
btn_flag:=true;
ref_file:= OpenDialog2.FileName;
ref_dir:= ExtractFilePath(OpenDialog2.FileName);
end
else
begin
ref_file:='';
btn_flag:=false;
end;
RefLabel.Caption:=ExtractFileName(OpenDialog2.FileName);
end;

procedure TForm1.ExitBtnClick(Sender: TObject);
begin
close;
end;

procedure TForm1.CreateBtnClick(Sender: TObject);
var
proc: textfile;
f_path, fle, sc, md, desc, cop, w_dir: string;

begin
m:='m';
alg:='l';
If (btn_flag) AND (Image1.IEBitmap.Height>1) then
begin
f_path:=ExtractFilePath(ref_file);
If scanner_edit.Text='' then
sc:=''
else
sc:=scanner_edit.Text;

If model_edit.Text='' then
md:=''
else
md:=model_edit.Text;

If descr_edit.Text='' then
desc:=''
else
desc:=descr_edit.Text;

If copy_edit.Text='' then
cop:=''
else
cop:=copy_edit.Text;
fle:= ExtractFilePath(Application.ExeName)+'proc.bat';
Assignfile(proc, fle);
Rewrite(proc);
Writeln(proc, '@echo off');
Writeln(proc, '"'+ExtractFilePath(Application.ExeName)+'argyll\bin\scanin" -v "'+icc_file+'" "'+ExtractFilePath(Application.ExeName)+'argyll\ref\It8.cht" "'+ref_file+'"');
Closefile(proc);
Proc_Run(fle, true);
If FileExists(ChangeFileExt(icc_file, '.ti3')) then
begin
AssignFile(proc, fle);
Rewrite(proc);
Writeln(proc, '@echo off');
Writeln(proc, '"'+ExtractFilePath(Application.ExeName)+'argyll\bin\profile" -v -A"'+sc+'" -M"'+md+'" -D"'+desc+'" -C"'+cop+'" -q'+m+' -a'+alg+' "'+
ChangeFileExt(icc_file, '')+'"');
CloseFile(proc);
Proc_Run(fle, true);
MessageDlg('ICC Profile Created. Please save it now...', mtInformation,
[mbOk], 0);
w_dir:=FindWin;
SaveDialog1.FileName:='';
SaveDialog1.InitialDir:=prof_dir;
SaveDialog1.DefaultExt:= '*.icm';
SaveDialog1.Filter:= 'ICC Profile File (*.icm)|*.icm';
SaveDialog1.Title:= 'Default profile folder is: "...\windows\system32\spool\drivers\color\"';
If SaveDialog1.Execute then
begin
out_file:=SaveDialog1.FileName;
CopyFile(PChar(ChangeFileExt(icc_file, '.icm')), PChar(out_file), False);
reg_change(Sender);
If FileExists(ChangeFileExt(icc_file, '.icm')) then
FileDeleteRB(ChangeFileExt(icc_file, '.icm'));
end;
If FileExists(fle) then
FileDeleteRB(fle);
If FileExists(ChangeFileExt(icc_File, '.ti3')) then
FileDeleteRB(ChangeFileExt(icc_File, '.ti3'));
end
else
MessageDlg('ERROR extracting RGB values. Cannot continue.', mtInformation,
[mbOk], 0);
end
else
MessageDlg('IT8 target or reference file not selected...', mtInformation,
[mbOk], 0);
end;

procedure TForm1.Proc_Run(ProgramName : String; Wait: Boolean);
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin
{ fill with known state }
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);
CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
nil, nil, StartInfo, ProcInfo);
{ check to see if successful }
if CreateOK then
begin
//may or may not be needed. Usually wait for child processes
if Wait then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end
else
begin
ShowMessage('Unable to run program.');
end;

CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);

end;

procedure TForm1.FormCreate(Sender: TObject);
var
myINI : TINIFile;

begin
CropBtn.Visible:=false;
Image1.Blank;
btn_flag:=false;
temp_img:=false;
Application.helpfile := extractfilepath(application.exename) + 'SIPC.HLP';
myINI := TINIFile.Create(ExtractFilePath(Application.EXEName) + 'sipc.ini');
tar_dir:=myINI.ReadString('Directories', 'TARGET', ExtractFileDrive(Application.EXEName)+'\');
ref_dir:=myINI.ReadString('Directories', 'REFERENCE', ExtractFileDrive(Application.EXEName)+'\');
scanner_edit.Text:=myINI.ReadString('Settings', 'SCANNER', 'Device_name');
model_edit.Text:=myINI.ReadString('Settings', 'MODEL', 'Model');
descr_edit.Text:=myINI.ReadString('Settings', 'DESCRIPTION', 'My_profile');
copy_edit.Text:=myINI.ReadString('Settings', 'COPYRIGHT', 'Copyright_free');
myINI.Free;
prof_dir:= FindWin+'\system32\spool\drivers\color';
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
Case RadioGroup1.ItemIndex of
0: m:='l';
1: m:='m';
2: m:='h';
3: m:='u';
else
m:='m';
end;

end;

function TForm1.FileDeleteRB(AFileName:string): boolean;
var Struct: TSHFileOpStruct;
pFromc: array[0..255] of char;
Resultval: integer;
begin
if not FileExists(AFileName) then begin
Result := False;
exit;
end
else begin
fillchar(pfromc,sizeof(pfromc),0) ;
StrPcopy(pfromc,expandfilename(AFileName)+#0#0) ;
Struct.wnd := 0;
Struct.wFunc := FO_DELETE;
Struct.pFrom := pFromC;
Struct.pTo := nil;
Struct.fFlags:= FOF_ALLOWUNDO or FOF_NOCONFIRMATION
or FOF_SILENT;
Struct.fAnyOperationsAborted := false;
Struct.hNameMappings := nil;
Resultval := ShFileOperation(Struct) ;
Result := (Resultval = 0) ;
end;
end;

 

procedure TForm1.InstrBtnClick(Sender: TObject);
begin
Form2.ShowModal;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
myINI : TINIFile;
begin
myINI := TINIFile.Create(ExtractFilePath(Application.EXEName) + 'sipc.ini');
myINI.WriteString('Directories', 'TARGET', tar_dir);
myINI.WriteString('Directories', 'REFERENCE', ref_dir);
myINI.WriteString('Settings', 'SCANNER', scanner_edit.text);
myINI.WriteString('Settings', 'MODEL', model_edit.text);
myINI.WriteString('Settings', 'DESCRIPTION', descr_edit.text);
myINI.WriteString('Settings', 'COPYRIGHT', copy_edit.text);
myINI.Free;
If FileExists(ExtractFilePath(Application.ExeName)+'temp.tif') then
FileDeleteRB(ExtractFilePath(Application.ExeName)+'temp.tif');
end;

procedure TForm1.reg_change(Sender: TObject) ;
var
B : Array [0..15] of Byte;
I : Byte;
R : TRegistry;

Const
SubKey : String = '\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ICM\scnr';

begin
R := TRegistry.Create;

with R do
begin
//
// Set random data
//
for I := 0 to 15 do
B[I] := Random(255);
//
// Create subkey
//
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(SubKey, true);
//
// write binary data
//
WriteBinaryData(ExtractFileName(out_file), B, SizeOf(B));
Free;
end;
end;

function TForm1.FindWin:string;
var
PWindowsDir: array [0..255] of Char;

begin
GetWindowsDirectory(PWindowsDir,255);
Result:=StrPas(PWindowsDir);
end;

procedure TForm1.CaptureBtnClick(Sender: TObject);
begin
image1.Blank;
form3.ShowModal;
Screen.Cursor:=crHourglass;
SaveDialog1.FileName:='';
SaveDialog1.InitialDir:= ExtractFileDrive(Application.ExeName)+'\';
SaveDialog1.DefaultExt:= '*.tif';
SaveDialog1.Filter:= 'TIFF Image (*.tif)|*.tif';
SaveDialog1.Title:= 'Please save the image.';
If SaveDialog1.Execute then
begin
Image1.IO.SaveToFileTIFF(SaveDialog1.FileName);
icc_file:= SaveDialog1.FileName;
imgLabel.Caption:= ExtractFileName(icc_file);
end
else
begin
Image1.Blank;
icc_file:='';
imgLabel.Caption:= '*.tif';
end;
Screen.Cursor:=crDefault;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
Image1.LegacyBitmap:=false;
Panel6.Visible:=false;
end;

procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
case RadioGroup2.ItemIndex of
0: alg:= 'l';
1: alg:= 'x';
2: alg:= 'g';
3: alg:= 's';
else
alg:='l';
end;
end;

procedure TForm1.image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Image1.Selected then
begin
CropBtn.Visible:=true;
image1.Hint:='Double-click inside selection to crop';
end
else
image1.hint:='Draw rectangle to crop image';
end;

procedure TForm1.CropbtnClick(Sender: TObject);
begin
if MessageDlg('Crop the image?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
Screen.Cursor:=crHourglass;
Image1.Proc.CropSel;
Image1.DeSelect;
Image1.LegacyBitmap:=false;
If FileExists(icc_file) then
FileDeleteRB(icc_file);
Image1.IO.SaveToFileTIFF(icc_file);
Screen.Cursor:=crDefault;
Image1.DeSelect;
end
else
begin
Image1.DeSelect;
CropBtn.Visible:=false;
end;
end;

procedure TForm1.image1SelectionChange(Sender: TObject);
begin
If image1.Selected then
begin
CropBtn.Visible:=true;
image1.Hint:= 'Double-click inside selection to crop';
end
else
begin
CropBtn.Visible:=false;
image1.Hint:='Draw rectangle to crop image';
end;
end;

procedure TForm1.image1DblClick(Sender: TObject);
begin
If Image1.Selected then
CropBtnClick(Sender);
end;

procedure TForm1.HelpBtnClick(Sender: TObject);
begin
Application.HelpCommand(HELP_CONTENTS, 0);
end;

procedure TForm1.VerBtnClick(Sender: TObject);
begin
Panel1.Enabled:=false;
Panel3.Enabled:=false;
Panel4.Enabled:=false;
upg1.CheckUpdate;
end;

procedure TForm1.upg1Progress(Sender: TObject; TotalSize, ReadSize,
ReadPercents: Integer);
begin
Panel6.Visible:=true;
ProgressBar1.Position := ReadPercents;
ProgressLabel.Caption := IntToStr(ReadPercents) + '% done...';
end;

procedure TForm1.upg1Done(Sender: TObject; FileSize: Integer);
begin
Panel6.Visible:=false;
Panel1.Enabled:=true;
Panel3.Enabled:=true;
Panel4.Enabled:=true;
end;

procedure TForm1.upg1NoUpdateAvailable(Sender: TObject);
begin
Application.MessageBox('No update available.',
PChar(Application.Title), mb_Ok or mb_IconInformation);
Panel1.Enabled:=true;
Panel3.Enabled:=true;
Panel4.Enabled:=true;
end;

procedure TForm1.upg1Error(Sender: TObject);
begin

screen.Cursor:=crDefault;
Application.MessageBox(PChar('An error has occurred on updating.'#13#10#10'Possible reasons:'#13#10 +
' 1. No Internet connection or connection lost.'#13#10 +
' 2. Update file not found.'#13#10 +
' 3. User cancelled the download.'), PChar(Application.Title+' Update'), mb_Ok or mb_IconStop);
Panel6.Visible:=false;
Panel1.Enabled:=true;
Panel3.Enabled:=true;
Panel4.Enabled:=true;
end;

end.


unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls, janWebLabel, ComCtrls, IdMultipartFormData,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
TForm2 = class(TForm)
Memo1: TMemo;
Panel2: TPanel;
Panel1: TPanel;
Image2: TImage;
Panel3: TPanel;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Button1: TButton;
Label6: TLabel;
janWebLabel1: TjanWebLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
begin
close;
end;

end.


unit Unit3;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, imageenio, ComCtrls, ieview, imageenview;

type
TForm3 = class(TForm)
GroupBox2: TGroupBox;
ComboBox1: TComboBox;
ImageEnIO1: TImageEnIO;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ProgressBar1: TProgressBar;
procedure FormActivate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ImageEnIO1Progress(Sender: TObject; per: Integer);

private
{ Private declarations }
procedure FillIn;

public
{ Public declarations }
end;

var
Form3: TForm3;
ie: TImageEnView;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm3.FormActivate(Sender: TObject);
var
i: integer;

begin
// fills TWain sources
If ImageEnIO1.TWainParams.SourceCount<> 0 then
begin
BitBtn1.Enabled:=true;
for i:=0 to ImageEnIO1.TWainParams.SourceCount-1 do
begin
ComboBox1.Items.Add( ImageEnIO1.TWainParams.SourceName[i] );
// Select first scanner
ComboBox1.ItemIndex:=0;
ImageEnIO1.TWainParams.SelectedSource:=ComboBox1.ItemIndex;
FillIn;
end;
end
else
begin
ShowMessage('Scanner NOT detected');
BitBtn1.Enabled:=false;
end;
end;

procedure TForm3.ComboBox1Change(Sender: TObject);
begin
ImageEnIO1.TWainParams.SelectedSource:=ComboBox1.ItemIndex;
FillIn;
end;

procedure TForm3.BitBtn1Click(Sender: TObject);
begin
ie:=TImageEnView.Create(nil);
FillIn;
ImageEnIO1.AttachedImageEn:= ie;
ImageEnIO1.Acquire;
ProgressBar1.Position:=0;
Form1.image1.Assign(ie);
ie.free;
close;
end;

procedure TForm3.BitBtn2Click(Sender: TObject);
begin
close;
end;

procedure TForm3.ImageEnIO1Progress(Sender: TObject; per: Integer);
begin
ProgressBar1.Position:=per;
ie.Update;
application.processmessages;
end;

procedure TForm3.FillIn;
begin
ImageEnIO1.TWainParams.VisibleDialog:=true;
ImageEnIO1.TWainParams.ProgressIndicators:=true;
ImageEnIO1.TWainParams.PixelType.CurrentValue:= 2;
ImageEnIO1.TWainParams.YResolution.CurrentValue:=300;
ImageEnIO1.TWainParams.XResolution.CurrentValue:=300;
ImageEnIO1.TWainParams.BufferedTransfer:=true;
end;

end.


unit CheckPrevious;

interface
uses Windows, SysUtils;

function RestoreIfRunning(
const AppHandle : THandle;
MaxInstances : integer = 1) : boolean;
implementation

type
PInstanceInfo = ^TInstanceInfo;
TInstanceInfo = packed record
PreviousHandle : THandle;
RunCounter : integer;
end;

var
MappingHandle: THandle;
InstanceInfo: PInstanceInfo;
MappingName : string;

RemoveMe : boolean = True;

function RestoreIfRunning(
const AppHandle : THandle;
MaxInstances : integer = 1) : boolean;
begin
Result := True;

MappingName := StringReplace(
ParamStr(0),
'\',
'',
[rfReplaceAll, rfIgnoreCase]);

MappingHandle := CreateFileMapping($FFFFFFFF,
nil,
PAGE_READWRITE,
0,
SizeOf(TInstanceInfo),
PChar(MappingName));

if MappingHandle = 0 then
RaiseLastOSError
else
begin
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
InstanceInfo := MapViewOfFile(MappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));

InstanceInfo^.PreviousHandle := AppHandle;
InstanceInfo^.RunCounter := 1;

Result := False;
end
else //already runing
begin
MappingHandle := OpenFileMapping(
FILE_MAP_ALL_ACCESS,
False,
PChar(MappingName));
if MappingHandle <> 0 then
begin
InstanceInfo := MapViewOfFile(MappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));

if InstanceInfo^.RunCounter >= MaxInstances then
begin
RemoveMe := False;

if IsIconic(InstanceInfo^.PreviousHandle) then
ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
SetForegroundWindow(InstanceInfo^.PreviousHandle);
end
else
begin
InstanceInfo^.PreviousHandle := AppHandle;
InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;

Result := False;
end
end;
end;
end;
end; (*RestoreIfRunning*)
initialization
//nothing special here
//we need this section because we have the
//finalization section

finalization
//remove this instance
if RemoveMe then
begin
MappingHandle := OpenFileMapping(
FILE_MAP_ALL_ACCESS,
False,
PChar(MappingName));
if MappingHandle <> 0 then
begin
InstanceInfo := MapViewOfFile(MappingHandle,
FILE_MAP_ALL_ACCESS,
0,
0,
SizeOf(TInstanceInfo));

InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
end
else
RaiseLastOSError;
end;

if Assigned(InstanceInfo) then UnmapViewOfFile(InstanceInfo);
if MappingHandle <> 0 then CloseHandle(MappingHandle);

end. (*unit CheckPrevious*)