Mercurial > hgrepos > Python2 > PyMuPDF
diff mupdf-source/thirdparty/lcms2/utils/delphi/demo1.pas @ 2:b50eed0cc0ef upstream
ADD: MuPDF v1.26.7: the MuPDF source as downloaded by a default build of PyMuPDF 1.26.4.
The directory name has changed: no version number in the expanded directory now.
| author | Franz Glasner <fzglas.hg@dom66.de> |
|---|---|
| date | Mon, 15 Sep 2025 11:43:07 +0200 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/mupdf-source/thirdparty/lcms2/utils/delphi/demo1.pas Mon Sep 15 11:43:07 2025 +0200 @@ -0,0 +1,322 @@ +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.
