| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306 |
- {
- Vampyre Imaging Library Demo
- LCL Imager (ObjectPascal, high level/component sets/canvas, Win32/Linux/macOS)
- tested in Lazarus 2.2.0 (Windows; Linux: Gtk2, Qt; macOS: Carbon, Cocoa)
- written by Marek Mauder
- Simple image manipulator program which shows usage of Imaging VCL/LCL
- classes (TImagingGraphic and its descendants) to display images on form.
- It also uses high level image classes and some low level functions.
- Demo uses TMultiImage class to store images (loaded from one file - MNG, DDS)
- which can be modified by user. After each modification image
- is assigned to TImagingBitmap class which provides visualization
- on the app form (using standard TImage component). Demo also uses new
- TImagingCanvas class to do some effects.
-
- In File menu you can open new image and save the current one. Items in
- View menu provide information about the current image and controls
- how it is displayed. You can also select next and previous subimage if loaded file
- contains more than one image. Format menu allows you to convert image
- to different image data formats supported by Imaging. Manipulate
- menu allows you to enlarge/shrink/flip/mirror/swap channels/other
- of the current image. Effects menu allows you to apply various effects to the
- image (provided by TImagingCanvas).
- }
- unit MainUnit;
-
- {$I ImagingOptions.inc}
- interface
- uses
- Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Variants,
- Menus, ExtCtrls, ExtDlgs, DemoUtils, AboutUnit, ActnList, StdCtrls, ComCtrls,
- PairSplitter, FileUtil,
- ImagingTypes,
- Imaging,
- ImagingClasses,
- ImagingComponents,
- ImagingCanvases,
- ImagingBinary,
- ImagingColors,
- ImagingUtility;
- type
- TManipulationType = (mtFlip, mtMirror, mtRotate90CW, mtRotate90CCW,
- mtFreeRotate, mtResize50, mtResize200, mtFreeResize,
- mtSwapRB, mtSwapRG, mtSwapGB, mtReduce1024,
- mtReduce256, mtReduce64, mtReduce16, mtReduce2);
- TPointTransform = (ptInvert, ptIncContrast, ptDecContrast, ptIncBrightness,
- ptDecBrightness, ptIncGamma, ptDecGamma, ptThreshold, ptLevelsLow,
- ptLevelsHigh, ptAlphaPreMult, ptAlphaUnPreMult);
- TNonLinearFilter = (nfMedian, nfMin, nfMax);
- TMorphology = (mpErode, mpDilate, mpOpen, mpClose);
- TAdditionalOp = (aoOtsuThreshold, aoDeskew);
- { TMainForm }
- TMainForm = class(TForm)
- ActViewInfo: TAction;
- ActViewFitToWindow: TAction;
- ActViewActualSize: TAction;
- ActionList: TActionList;
- Image: TImage;
- MainMenu: TMainMenu;
- MenuItem1: TMenuItem;
- MenuItem10: TMenuItem;
- MenuItem11: TMenuItem;
- MenuItem12: TMenuItem;
- MenuItem13: TMenuItem;
- MenuItem14: TMenuItem;
- MenuItem15: TMenuItem;
- MenuItem16: TMenuItem;
- MenuItem17: TMenuItem;
- FormatItem: TMenuItem;
- MenuItem18: TMenuItem;
- MenuItem19: TMenuItem;
- MenuItem2: TMenuItem;
- MenuItem20: TMenuItem;
- MenuItem21: TMenuItem;
- MenuItem22: TMenuItem;
- MenuItem23: TMenuItem;
- MenuItem24: TMenuItem;
- MenuItem25: TMenuItem;
- MenuItem26: TMenuItem;
- MenuItem27: TMenuItem;
- MenuItem28: TMenuItem;
- MenuItem29: TMenuItem;
- MenuItem3: TMenuItem;
- MenuItem30: TMenuItem;
- MenuItem31: TMenuItem;
- MenuItem32: TMenuItem;
- MenuItem33: TMenuItem;
- MenuItem36: TMenuItem;
- MenuItem37: TMenuItem;
- MenuItem38: TMenuItem;
- MenuItem39: TMenuItem;
- MenuItem40: TMenuItem;
- MenuItem41: TMenuItem;
- MenuItem42: TMenuItem;
- MenuItem43: TMenuItem;
- MenuItem44: TMenuItem;
- MenuItem45: TMenuItem;
- MenuItem46: TMenuItem;
- MenuItem47: TMenuItem;
- MenuItem48: TMenuItem;
- MenuItem49: TMenuItem;
- MenuItem50: TMenuItem;
- MenuItem51: TMenuItem;
- MenuItem52: TMenuItem;
- MenuItem53: TMenuItem;
- MenuItem54: TMenuItem;
- MenuItem55: TMenuItem;
- MenuItem56: TMenuItem;
- MenuItem57: TMenuItem;
- MenuItem58: TMenuItem;
- MenuItem59: TMenuItem;
- MenuItem60: TMenuItem;
- MenuItem61: TMenuItem;
- MenuItem62: TMenuItem;
- MenuItem63: TMenuItem;
- MenuItem64: TMenuItem;
- MenuItem65: TMenuItem;
- MenuItem66: TMenuItem;
- MenuItem67: TMenuItem;
- MenuItem68: TMenuItem;
- MenuItem69: TMenuItem;
- MenuItem70: TMenuItem;
- MenuItem91: TMenuItem;
- MenuItem92: TMenuItem;
- MenuItem93: TMenuItem;
- MIMorphology: TMenuItem;
- MenuItem71: TMenuItem;
- MenuItem72: TMenuItem;
- MenuItem73: TMenuItem;
- MenuItem74: TMenuItem;
- MenuItem75: TMenuItem;
- MenuItem76: TMenuItem;
- MenuItem77: TMenuItem;
- AlphaItem: TMenuItem;
- MenuItem78: TMenuItem;
- MenuItem79: TMenuItem;
- MenuItem80: TMenuItem;
- MenuItem81: TMenuItem;
- MenuItem83: TMenuItem;
- MenuItem84: TMenuItem;
- MenuItem85: TMenuItem;
- MenuItem86: TMenuItem;
- MenuItem87: TMenuItem;
- MenuItem88: TMenuItem;
- MenuItem89: TMenuItem;
- MenuItem90: TMenuItem;
- MenuItemConvertAll: TMenuItem;
- MIAdditional: TMenuItem;
- PairSplitter: TPairSplitter;
- PairSplitterSideLeft: TPairSplitterSide;
- PairSplitterSideRight: TPairSplitterSide;
- RedItem: TMenuItem;
- GreenItem: TMenuItem;
- BlueItem: TMenuItem;
- MenuItem82: TMenuItem;
- MenuItemActSubImage: TMenuItem;
- MenuItem34: TMenuItem;
- MenuItem35: TMenuItem;
- MenuItem4: TMenuItem;
- MenuItem5: TMenuItem;
- MenuItem6: TMenuItem;
- MenuItem7: TMenuItem;
- MenuItem8: TMenuItem;
- MenuItem9: TMenuItem;
- OpenDialog: TOpenPictureDialog;
- SaveDialog: TSavePictureDialog;
- StatusBar: TStatusBar;
- TreeImage: TTreeView;
- procedure ActViewFitToWindowExecute(Sender: TObject);
- procedure ActViewInfoExecute(Sender: TObject);
- procedure ActViewActualSizeExecute(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
- procedure FormShow(Sender: TObject);
- procedure ImageClick(Sender: TObject);
- procedure MenuItem10Click(Sender: TObject);
- procedure MenuItem12Click(Sender: TObject);
- procedure MenuItem13Click(Sender: TObject);
- procedure MenuItem14Click(Sender: TObject);
- procedure MenuItem15Click(Sender: TObject);
- procedure MenuItem18Click(Sender: TObject);
- procedure MenuItem19Click(Sender: TObject);
- procedure MenuItem20Click(Sender: TObject);
- procedure MenuItem23Click(Sender: TObject);
- procedure MenuItem24Click(Sender: TObject);
- procedure MenuItem26Click(Sender: TObject);
- procedure MenuItem27Click(Sender: TObject);
- procedure MenuItem28Click(Sender: TObject);
- procedure MenuItem29Click(Sender: TObject);
- procedure MenuItem2Click(Sender: TObject);
- procedure MenuItem30Click(Sender: TObject);
- procedure MenuItem31Click(Sender: TObject);
- procedure MenuItem33Click(Sender: TObject);
- procedure MenuItem34Click(Sender: TObject);
- procedure MenuItem35Click(Sender: TObject);
- procedure MenuItem37Click(Sender: TObject);
- procedure MenuItem38Click(Sender: TObject);
- procedure MenuItem39Click(Sender: TObject);
- procedure MenuItem3Click(Sender: TObject);
- procedure MenuItem40Click(Sender: TObject);
- procedure MenuItem41Click(Sender: TObject);
- procedure MenuItem42Click(Sender: TObject);
- procedure MenuItem43Click(Sender: TObject);
- procedure MenuItem44Click(Sender: TObject);
- procedure MenuItem45Click(Sender: TObject);
- procedure MenuItem46Click(Sender: TObject);
- procedure MenuItem47Click(Sender: TObject);
- procedure MenuItem48Click(Sender: TObject);
- procedure MenuItem4Click(Sender: TObject);
- procedure MenuItem50Click(Sender: TObject);
- procedure MenuItem51Click(Sender: TObject);
- procedure MenuItem53Click(Sender: TObject);
- procedure MenuItem54Click(Sender: TObject);
- procedure MenuItem56Click(Sender: TObject);
- procedure MenuItem57Click(Sender: TObject);
- procedure MenuItem58Click(Sender: TObject);
- procedure MenuItem59Click(Sender: TObject);
- procedure MenuItem5Click(Sender: TObject);
- procedure MenuItem60Click(Sender: TObject);
- procedure MenuItem61Click(Sender: TObject);
- procedure MenuItem62Click(Sender: TObject);
- procedure MenuItem64Click(Sender: TObject);
- procedure MenuItem65Click(Sender: TObject);
- procedure MenuItem66Click(Sender: TObject);
- procedure MenuItem67Click(Sender: TObject);
- procedure MenuItem68Click(Sender: TObject);
- procedure MenuItem69Click(Sender: TObject);
- procedure MenuItem70Click(Sender: TObject);
- procedure MenuItem71Click(Sender: TObject);
- procedure MenuItem72Click(Sender: TObject);
- procedure MenuItem73Click(Sender: TObject);
- procedure MenuItem74Click(Sender: TObject);
- procedure MenuItem75Click(Sender: TObject);
- procedure MenuItem76Click(Sender: TObject);
- procedure MenuItem78Click(Sender: TObject);
- procedure MenuItem79Click(Sender: TObject);
- procedure MenuItem7Click(Sender: TObject);
- procedure FormatChangeClick(Sender: TObject);
- procedure ChannelSetClick(Sender: TObject);
- procedure MenuItem80Click(Sender: TObject);
- procedure MenuItem82Click(Sender: TObject);
- procedure MenuItem83Click(Sender: TObject);
- procedure MenuItem84Click(Sender: TObject);
- procedure MenuItem85Click(Sender: TObject);
- procedure MenuItem86Click(Sender: TObject);
- procedure MenuItem88Click(Sender: TObject);
- procedure MenuItem89Click(Sender: TObject);
- procedure MenuItem90Click(Sender: TObject);
- procedure MenuItem91Click(Sender: TObject);
- procedure MenuItem92Click(Sender: TObject);
- procedure TreeImageSelectionChanged(Sender: TObject);
- private
- FBitmap: TImagingBitmap;
- FImage: TMultiImage;
- FImageCanvas: TImagingCanvas;
- FFileName: string;
- FFileSize: Integer;
- FParam1, FParam2, FParam3: Integer;
- procedure OpenFile(const FileName: string);
- procedure SaveFile(const FileName: string);
- procedure SelectSubImage(Index: LongInt);
- procedure UpdateView(RebuildTree: Boolean);
- function CheckCanvasFormat: Boolean;
- procedure ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
- procedure ApplyPointTransform(Transform: TPointTransform);
- procedure ApplyManipulation(ManipType: TManipulationType);
- procedure ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
- procedure ApplyMorphology(MorphOp: TMorphology);
- procedure ApplyAdditionalOp(Op: TAdditionalOp);
- procedure MeasureTime(const Msg: string; const OldTime: Int64);
- procedure FreeResizeInput;
- function InputInteger(const ACaption, APrompt: string; var Value: Integer): Boolean;
- procedure BuildImageTree;
- public
- end;
- const
- SWindowTitle = 'LCL Imager - Vampyre Imaging Library %s Demo';
-
- var
- MainForm: TMainForm;
- implementation
- {$R *.lfm}
- {$IFDEF MSWINDOWS}
- uses
- Windows;
- {$ENDIF}
- { TMainForm }
- procedure TMainForm.FormCreate(Sender: TObject);
- var
- Item: TMenuItem;
- Fmt: TImageFormat;
- Info: TImageFormatInfo;
- Platform: string;
- function Clone(AItem: TMenuItem): TMenuItem;
- begin
- Result := TMenuItem.Create(MainMenu);
- Result.Caption := AItem.Caption;
- Result.Tag := AItem.Tag;
- Result.OnClick := AItem.OnClick;;
- end;
- procedure AddSetChannelItem(const Caption: string; Value: Integer);
- begin
- Item := TMenuItem.Create(MainMenu);
- Item.Caption := Caption;
- Item.Tag := Value;
- Item.OnClick := ChannelSetClick;
- AlphaItem.Add(Item);
- RedItem.Add(Clone(Item));
- GreenItem.Add(Clone(Item));
- BlueItem.Add(Clone(Item));
- end;
- begin
- Platform := '';
- {$IF Defined(WIN64)}
- Platform := ' - WIN64';
- {$ELSEIF Defined(WIN32)}
- Platform := ' - WIN32';
- {$ELSEIF Defined(LINUX)}
- Platform := ' - Linux';
- {$ELSEIF Defined(DARWIN)}
- Platform := ' - macOS';
- {$ENDIF}
- Caption := Format(SWindowTitle, [Imaging.GetVersionStr]) + Platform;
- { Source image and Image's graphic are created and
- default image is opened.}
- FImage := TMultiImage.Create;
- FBitmap := TImagingBitmap.Create;
- Image.Picture.Graphic := FBitmap;
- FImageCanvas := TImagingCanvas.Create;
- { This builds Format submenu containing all possible
- image data formats (it dos not start at Low(TImageFormat)
- because there are some helper formats). Format for each item
- is stored in its Tag for later use in OnClick event.}
- for Fmt := ifIndex8 to High(TImageFormat) do
- begin
- GetImageFormatInfo(Fmt, Info);
- if Info.Name <> '' then
- begin
- Item := TMenuItem.Create(MainMenu);
- Item.Caption := Info.Name;
- Item.Tag := Ord(Fmt);
- Item.OnClick := FormatChangeClick;
- FormatItem.Add(Item);
- end;
- end;
- AddSetChannelItem('Set to 5%', 12);
- AddSetChannelItem('Set to 50%', 128);
- AddSetChannelItem('Set to 100%', 255);
- // Set 'Fit to window' mode
- ActViewFitToWindowExecute(Self);
- if (ParamCount > 0) and FileExists(ParamStr(1)) then
- OpenFile(ParamStr(1))
- else if FileExists(FileNameInDataDir('Tigers.jpg')) then
- OpenFile(FileNameInDataDir('Tigers.jpg'));
- end;
- procedure TMainForm.MenuItem10Click(Sender: TObject);
- begin
- AboutForm.ShowModal;
- end;
- procedure TMainForm.MenuItem12Click(Sender: TObject);
- begin
- ApplyManipulation(mtSwapRB);
- end;
- procedure TMainForm.MenuItem13Click(Sender: TObject);
- begin
- ApplyManipulation(mtSwapRG);
- end;
- procedure TMainForm.MenuItem14Click(Sender: TObject);
- begin
- ApplyManipulation(mtSwapGB);
- end;
- procedure TMainForm.MenuItem15Click(Sender: TObject);
- begin
- ApplyManipulation(mtReduce1024);
- end;
- procedure TMainForm.MenuItem18Click(Sender: TObject);
- begin
- ApplyManipulation(mtReduce256);
- end;
- procedure TMainForm.MenuItem19Click(Sender: TObject);
- begin
- ApplyManipulation(mtReduce64);
- end;
- procedure TMainForm.MenuItem20Click(Sender: TObject);
- begin
- ApplyManipulation(mtReduce16);
- end;
- procedure TMainForm.MenuItem4Click(Sender: TObject);
- begin
- ApplyManipulation(mtMirror);
- end;
- procedure TMainForm.MenuItem23Click(Sender: TObject);
- begin
- ApplyManipulation(mtRotate90CW);
- end;
- procedure TMainForm.MenuItem24Click(Sender: TObject);
- begin
- ApplyManipulation(mtRotate90CCW);
- end;
- procedure TMainForm.MenuItem26Click(Sender: TObject);
- begin
- FParam1 := Ord(rfNearest);
- ApplyManipulation(mtResize50);
- end;
- procedure TMainForm.MenuItem27Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBilinear);
- ApplyManipulation(mtResize50);
- end;
- procedure TMainForm.MenuItem28Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBicubic);
- ApplyManipulation(mtResize50);
- end;
- procedure TMainForm.MenuItem29Click(Sender: TObject);
- begin
- FParam1 := Ord(rfNearest);
- ApplyManipulation(mtResize200);
- end;
- procedure TMainForm.MenuItem30Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBilinear);
- ApplyManipulation(mtResize200);
- end;
- procedure TMainForm.MenuItem31Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBicubic);
- ApplyManipulation(mtResize200);
- end;
- procedure TMainForm.MenuItem2Click(Sender: TObject);
- begin
- ApplyManipulation(mtFlip);
- end;
- procedure TMainForm.MenuItem33Click(Sender: TObject);
- begin
- ApplyManipulation(mtReduce2);
- end;
- procedure TMainForm.MenuItem37Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterGaussian3x3, 3, False);
- end;
- procedure TMainForm.MenuItem38Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterGaussian5x5, 5, False);
- end;
- procedure TMainForm.MenuItem39Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterSharpen3x3, 3, False);
- end;
- procedure TMainForm.MenuItem40Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterSharpen5x5, 5, False);
- end;
- procedure TMainForm.MenuItem41Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterLaplace5x5, 5, True);
- end;
- procedure TMainForm.MenuItem42Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterSobelHorz3x3, 3, True);
- end;
- procedure TMainForm.MenuItem43Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterSobelVert3x3, 3, True);
- end;
- procedure TMainForm.MenuItem44Click(Sender: TObject);
- begin
- OpenFile(FFileName);
- end;
- procedure TMainForm.MenuItem45Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterGlow5x5, 5, False);
- end;
- procedure TMainForm.MenuItem46Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterEmboss3x3, 3, True);
- end;
- procedure TMainForm.MenuItem47Click(Sender: TObject);
- begin
- ApplyPointTransform(ptIncContrast);
- end;
- procedure TMainForm.MenuItem48Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterEdgeEnhance3x3, 3, False);
- end;
- procedure TMainForm.MenuItem50Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterPrewittHorz3x3, 3, True);
- end;
- procedure TMainForm.MenuItem51Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterKirshHorz3x3, 3, True);
- end;
- procedure TMainForm.MenuItem53Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterPrewittVert3x3, 3, True);
- end;
- procedure TMainForm.MenuItem54Click(Sender: TObject);
- begin
- ApplyConvolution(@FilterKirshVert3x3, 3, True);
- end;
- procedure TMainForm.MenuItem56Click(Sender: TObject);
- begin
- ApplyPointTransform(ptInvert);
- end;
- procedure TMainForm.MenuItem57Click(Sender: TObject);
- begin
- ApplyPointTransform(ptDecContrast);
- end;
- procedure TMainForm.MenuItem58Click(Sender: TObject);
- begin
- ApplyPointTransform(ptIncBrightness);
- end;
- procedure TMainForm.MenuItem59Click(Sender: TObject);
- begin
- ApplyPointTransform(ptDecBrightness);
- end;
- procedure TMainForm.MenuItem34Click(Sender: TObject);
- begin
- SelectSubImage(FImage.ActiveImage + 1);
- end;
- procedure TMainForm.MenuItem35Click(Sender: TObject);
- begin
- SelectSubImage(FImage.ActiveImage - 1);
- end;
- function TMainForm.CheckCanvasFormat: Boolean;
- begin
- Result := FImage.Format in FImageCanvas.GetSupportedFormats;
- if not Result then
- MessageDlg('Image is in format that is not supported by TImagingCanvas.', mtError, [mbOK], 0);
- end;
- procedure TMainForm.ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
- var
- T: Int64;
- begin
- if CheckCanvasFormat then
- begin
- FImageCanvas.CreateForImage(FImage);
- T := GetTimeMicroseconds;
-
- if NeedsBlur then
- FImageCanvas.ApplyConvolution3x3(FilterGaussian3x3);
- if Size = 3 then
- FImageCanvas.ApplyConvolution3x3(TConvolutionFilter3x3(Kernel^))
- else
- FImageCanvas.ApplyConvolution5x5(TConvolutionFilter5x5(Kernel^));
-
- MeasureTime('Image convolved in:', T);
- UpdateView(False);
- end;
- end;
- procedure TMainForm.ApplyPointTransform(Transform: TPointTransform);
- var
- T: Int64;
- begin
- if CheckCanvasFormat then
- begin
- FImageCanvas.CreateForImage(FImage);
- T := GetTimeMicroseconds;
- case Transform of
- ptInvert: FImageCanvas.InvertColors;
- ptIncContrast: FImageCanvas.ModifyContrastBrightness(20, 0);
- ptDecContrast: FImageCanvas.ModifyContrastBrightness(-20, 0);
- ptIncBrightness: FImageCanvas.ModifyContrastBrightness(0, 20);
- ptDecBrightness: FImageCanvas.ModifyContrastBrightness(0, -20);
- ptIncGamma: FImageCanvas.GammaCorrection(1.2, 1.2, 1.2);
- ptDecGamma: FImageCanvas.GammaCorrection(0.8, 0.8, 0.8);
- ptThreshold: FImageCanvas.Threshold(0.5, 0.5, 0.5);
- ptLevelsLow: FImageCanvas.AdjustColorLevels(0.0, 0.5, 1.0);
- ptLevelsHigh: FImageCanvas.AdjustColorLevels(0.35, 1.0, 0.9);
- ptAlphaPreMult: FImageCanvas.PremultiplyAlpha;
- ptAlphaUnPreMult: FImageCanvas.UnPremultiplyAlpha;
- end;
- MeasureTime('Point transform done in:', T);
- UpdateView(False);
- end;
- end;
- procedure TMainForm.ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
- var
- T: Int64;
- begin
- if CheckCanvasFormat then
- begin
- FImageCanvas.CreateForImage(FImage);
- T := GetTimeMicroseconds;
- case FilterType of
- nfMedian: FImageCanvas.ApplyMedianFilter(FilterSize);
- nfMin: FImageCanvas.ApplyMinFilter(FilterSize);
- nfMax: FImageCanvas.ApplyMaxFilter(FilterSize);
- end;
- MeasureTime('Point transform done in:', T);
- UpdateView(False);
- end;
- end;
- procedure TMainForm.ApplyMorphology(MorphOp: TMorphology);
- var
- T: Int64;
- Strel: TStructElement;
- begin
- T := GetTimeMicroseconds;
- FImage.Format := ifGray8;
- OtsuThresholding(FImage.ImageDataPointer^);
-
- SetLength(Strel, 3, 3);
- Strel[0, 0] := 0;
- Strel[1, 0] := 1;
- Strel[2, 0] := 0;
- Strel[0, 1] := 1;
- Strel[1, 1] := 1;
- Strel[2, 1] := 1;
- Strel[0, 2] := 0;
- Strel[1, 2] := 1;
- Strel[2, 2] := 0;
- case MorphOp of
- mpErode: Morphology(FImage.ImageDataPointer^, Strel, moErode);
- mpDilate: Morphology(FImage.ImageDataPointer^, Strel, moDilate);
- mpOpen:
- begin
- Morphology(FImage.ImageDataPointer^, Strel, moErode);
- Morphology(FImage.ImageDataPointer^, Strel, moDilate);
- end;
- mpClose:
- begin
- Morphology(FImage.ImageDataPointer^, Strel, moDilate);
- Morphology(FImage.ImageDataPointer^, Strel, moErode);
- end;
- end;
- MeasureTime('Morphology operation applied in:', T);
- UpdateView(True);
- end;
- procedure TMainForm.ApplyAdditionalOp(Op: TAdditionalOp);
- var
- T: Int64;
- begin
- T := GetTimeMicroseconds;
- case Op of
- aoOtsuThreshold:
- begin
- FImage.Format := ifGray8;
- OtsuThresholding(FImage.ImageDataPointer^, True);
- end;
- aoDeskew: DeskewImage(FImage.ImageDataPointer^);
- end;
- MeasureTime('Operation completed in:', T);
- UpdateView(False);
- end;
- procedure TMainForm.ApplyManipulation(ManipType: TManipulationType);
- var
- T: Int64;
- OldFmt: TImageFormat;
- OldSize: Integer;
- RebuildTree: Boolean;
- begin
- OldFmt := FImage.Format;
- OldSize := FImage.Size;
- T := GetTimeMicroseconds;
- case ManipType of
- mtFlip: FImage.Flip;
- mtMirror: FImage.Mirror;
- mtRotate90CW: FImage.Rotate(-90);
- mtRotate90CCW: FImage.Rotate(90);
- mtFreeRotate: FImage.Rotate(FParam1);
- mtResize50: FImage.Resize(FImage.Width div 2, FImage.Height div 2, TResizeFilter(FParam1));
- mtResize200: FImage.Resize(FImage.Width * 2, FImage.Height * 2, TResizeFilter(FParam1));
- mtFreeResize: FImage.Resize(FParam2, FParam3, TResizeFilter(FParam1));
- mtSwapRB: FImage.SwapChannels(ChannelRed, ChannelBlue);
- mtSwapRG: FImage.SwapChannels(ChannelRed, ChannelGreen);
- mtSwapGB: FImage.SwapChannels(ChannelGreen, ChannelBlue);
- mtReduce1024: ReduceColors(FImage.ImageDataPointer^, 1024);
- mtReduce256: ReduceColors(FImage.ImageDataPointer^, 256);
- mtReduce64: ReduceColors(FImage.ImageDataPointer^, 64);
- mtReduce16: ReduceColors(FImage.ImageDataPointer^, 16);
- mtReduce2: ReduceColors(FImage.ImageDataPointer^, 2);
- end;
- MeasureTime('Image manipulated in:', T);
- RebuildTree := (FImage.Format <> OldFmt) or (FImage.Size <> OldSize);
- UpdateView(RebuildTree);
- end;
- procedure TMainForm.FormatChangeClick(Sender: TObject);
- var
- T: Int64;
- Fmt: TImageFormat;
- begin
- with Sender as TMenuItem do
- begin
- T := GetTimeMicroseconds;
- Fmt := TImageFormat(Tag);
- if MenuItemConvertAll.Checked then
- FImage.ConvertImages(Fmt)
- else
- FImage.Format := Fmt;
- MeasureTime('Image converted in:', T);
- UpdateView(True);
- end;
- end;
- procedure TMainForm.ChannelSetClick(Sender: TObject);
- var
- T: Int64;
- Canvas: TImagingCanvas;
- ChanId: Integer;
- begin
- if CheckCanvasFormat then
- with Sender as TMenuItem do
- begin
- case Parent.Caption[1] of
- 'A': ChanId := ChannelAlpha;
- 'R': ChanId := ChannelRed;
- 'G': ChanId := ChannelGreen;
- 'B': ChanId := ChannelBlue;
- else
- ChanId := ChannelRed;
- end;
- Canvas := TImagingCanvas.CreateForImage(FImage);
- T := GetTimeMicroseconds;
- Canvas.FillChannel(ChanId, Tag);
- MeasureTime('Channel filled in:', T);
- Canvas.Free;
- UpdateView(False);
- end;
- end;
- procedure TMainForm.MenuItem80Click(Sender: TObject);
- begin
- if InputInteger('Free Rotate', 'Enter angle in degrees:', FParam1) then
- ApplyManipulation(mtFreeRotate);
- end;
- procedure TMainForm.FreeResizeInput;
- begin
- if InputInteger('Free Resize', 'Enter width in pixels', FParam2) and
- InputInteger('Free Resize', 'Enter height in pixels', FParam3) then
- begin
- ApplyManipulation(mtFreeResize);
- end;
- end;
- function TMainForm.InputInteger(const ACaption, APrompt: string;
- var Value: Integer): Boolean;
- var
- StrVal: string;
- begin
- Result := False;
- StrVal := '';
- if Dialogs.InputQuery(ACaption, APrompt, StrVal) then
- begin
- if TryStrToInt(StrVal, Value) then
- Exit(True)
- else
- MessageDlg('Cannot convert input to number', mtError, [mbOK], 0);
- end;
- end;
- procedure TMainForm.MenuItem82Click(Sender: TObject);
- var
- T: Int64;
- Canvas: TImagingCanvas;
- Red, Green, Blue, Alpha, Gray: THistogramArray;
- I, MaxPixels: Integer;
- Factor: Single;
- procedure VisualizeHistogram(const Histo: THistogramArray; Color: TColor32; Offset: Integer);
- var
- I: Integer;
- begin
- Canvas.PenColor32 := Color;
- for I := 0 to 255 do
- Canvas.VertLine(I + Offset, 256 - Round(Histo[I] * Factor), 255);
- end;
- begin
- if CheckCanvasFormat then
- begin
- Canvas := TImagingCanvas.CreateForImage(FImage);
- T := GetTimeMicroseconds;
- Canvas.GetHistogram(Red, Green, Blue, Alpha, Gray);
- MeasureTime('Histograms computed in:', T);
- FImage.ActiveImage := FImage.AddImage(1024, 256, ifA8R8G8B8);
- Canvas.CreateForImage(FImage);
- Canvas.FillColor32 := pcBlack;
- Canvas.FillRect(FImage.BoundsRect);
- MaxPixels := 0;
- for I := 0 to 255 do
- if Red[I] > MaxPixels then MaxPixels := Red[I];
- for I := 0 to 255 do
- if Green[I] > MaxPixels then MaxPixels := Green[I];
- for I := 0 to 255 do
- if Blue[I] > MaxPixels then MaxPixels := Blue[I];
- for I := 0 to 255 do
- if Gray[I] > MaxPixels then MaxPixels := Gray[I];
- Factor := 256 / MaxPixels;
- VisualizeHistogram(Red, pcRed, 0);
- VisualizeHistogram(Green, pcGreen, 256);
- VisualizeHistogram(Blue, pcBlue, 512);
- VisualizeHistogram(Gray, pcGray, 768);
- Canvas.Free;
- UpdateView(True);
- end;
- end;
- procedure TMainForm.MenuItem83Click(Sender: TObject);
- begin
- FParam1 := Ord(rfNearest);
- FreeResizeInput;
- end;
- procedure TMainForm.MenuItem84Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBilinear);
- FreeResizeInput;
- end;
- procedure TMainForm.MenuItem85Click(Sender: TObject);
- begin
- FParam1 := Ord(rfBicubic);
- FreeResizeInput;
- end;
- procedure TMainForm.MenuItem86Click(Sender: TObject);
- var
- Form: TForm;
- Memo: TMemo;
- I: Integer;
- Item: TMetadataItem;
- S: string;
- begin
- Form := TForm.Create(Self);
- Form.BorderIcons := [biSystemMenu];
- Form.Caption := 'Detected Image Metadata';
- Form.Position := poOwnerFormCenter;
- Form.Width := 512;
- Form.Height := 512;
- Memo := TMemo.Create(Form);
- Memo.Parent := Form;
- Memo.Align := alClient;
- Memo.ReadOnly := True;
- Memo.ScrollBars := ssVertical;
- if GlobalMetadata.MetaItemCount > 0 then
- begin
- for I := 0 to GlobalMetadata.MetaItemCount - 1 do
- begin
- Item := GlobalMetadata.MetaItemsByIdx[I];
- S := Format('%s (idx: %d, type: %s): %s', [Item.Id, Item.ImageIndex,
- VarTypeAsText(VarType(Item.Value)), VarToStrDef(Item.Value, 'couldn''t convert Variant to string')]);
- Memo.Lines.Add(S);
- end;
- end
- else
- Memo.Lines.Add('No metadata loaded for this image');
- Form.ShowModal;
- Form.Free;
- end;
- procedure TMainForm.MenuItem88Click(Sender: TObject);
- begin
- FParam1 := Ord(rfLanczos);
- ApplyManipulation(mtResize50);
- end;
- procedure TMainForm.MenuItem89Click(Sender: TObject);
- begin
- FParam1 := Ord(rfLanczos);
- ApplyManipulation(mtResize200);
- end;
- procedure TMainForm.MenuItem90Click(Sender: TObject);
- begin
- FParam1 := Ord(rfLanczos);
- FreeResizeInput;
- end;
- procedure TMainForm.MenuItem91Click(Sender: TObject);
- begin
- ApplyAdditionalOp(aoDeskew);
- end;
- procedure TMainForm.MenuItem92Click(Sender: TObject);
- var
- Images: TMultiImage;
- begin
- OpenDialog.Filter := GetImageFileFormatsFilter(True);
- if OpenDialog.Execute then
- begin
- Images := TMultiImage.Create;
- try
- Images.LoadMultiFromFile(OpenDialog.FileName);
- FImage.AddImages(Images.DataArray);
- BuildImageTree;
- SelectSubImage(FImage.ActiveImage);
- finally
- Images.Free;
- end;
- end;
- end;
- procedure TMainForm.TreeImageSelectionChanged(Sender: TObject);
- var
- Node: TTreeNode;
- begin
- Node := TreeImage.Selected;
- if Node <> nil then
- SelectSubImage(PtrInt(Node.Data));
- end;
- procedure TMainForm.ActViewActualSizeExecute(Sender: TObject);
- begin
- ActViewActualSize.Checked := True;
- ActViewFitToWindow.Checked := False;
- Image.Proportional := False;
- Image.Stretch := False;
- end;
- procedure TMainForm.ActViewFitToWindowExecute(Sender: TObject);
- begin
- ActViewFitToWindow.Checked := True;
- ActViewActualSize.Checked := False;
- Image.Proportional := True;
- Image.Stretch := True;
- end;
- procedure TMainForm.ActViewInfoExecute(Sender: TObject);
- begin
- {$IFDEF MSWINDOWS}
- // For some strange reason ordinary MessageDlg sometimes shows empty message for
- // A8R8G8B8 images. Using Win32 msg box instead now.
- MessageBox(Handle, PChar(ImageToStr(FImage.ImageDataPointer^)), 'Image information', MB_OK or MB_ICONINFORMATION);
- {$ELSE}
- MessageDlg(ImageToStr(FImage.ImageDataPointer^), mtInformation, [mbOK], 0);
- {$ENDIF}
- end;
- procedure TMainForm.FormDestroy(Sender: TObject);
- begin
- FImageCanvas.Free;
- FBitmap.Free;
- FImage.Free;
- end;
- procedure TMainForm.FormDropFiles(Sender: TObject;
- const FileNames: array of String);
- begin
- if Length(FileNames) > 0 then
- OpenFile(FileNames[0]);
- end;
- procedure TMainForm.FormShow(Sender: TObject);
- begin
- if ClientWidth > 600 then
- PairSplitterSideLeft.Width := 280;
- WindowState := wsMaximized;
- end;
- procedure TMainForm.ImageClick(Sender: TObject);
- begin
- ActViewInfo.Execute;
- end;
- procedure TMainForm.MenuItem3Click(Sender: TObject);
- begin
- OpenDialog.Filter := GetImageFileFormatsFilter(True);
- if OpenDialog.Execute then
- OpenFile(OpenDialog.FileName);
- end;
- procedure TMainForm.MenuItem5Click(Sender: TObject);
- begin
- SaveDialog.Filter := GetImageFileFormatsFilter(False);
- SaveDialog.FileName := ChangeFileExt(ExtractFileName(FFileName), '');
- SaveDialog.FilterIndex := GetFileNameFilterIndex(FFileName, False);
- if SaveDialog.Execute then
- begin
- FFileName := ChangeFileExt(SaveDialog.FileName, '.' + GetFilterIndexExtension(SaveDialog.FilterIndex, False));
- SaveFile(FFileName);
- end;
- end;
- procedure TMainForm.MenuItem60Click(Sender: TObject);
- begin
- ApplyPointTransform(ptIncGamma);
- end;
- procedure TMainForm.MenuItem61Click(Sender: TObject);
- begin
- ApplyPointTransform(ptDecGamma);
- end;
- procedure TMainForm.MenuItem62Click(Sender: TObject);
- begin
- ApplyPointTransform(ptThreshold);
- end;
- procedure TMainForm.MenuItem64Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMedian, 3);
- end;
- procedure TMainForm.MenuItem65Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMedian, 5);
- end;
- procedure TMainForm.MenuItem66Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMin, 3);
- end;
- procedure TMainForm.MenuItem67Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMin, 5);
- end;
- procedure TMainForm.MenuItem68Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMax, 3);
- end;
- procedure TMainForm.MenuItem69Click(Sender: TObject);
- begin
- ApplyNonLinear(nfMax, 5);
- end;
- procedure TMainForm.MenuItem70Click(Sender: TObject);
- begin
- ApplyAdditionalOp(aoOtsuThreshold);
- end;
- procedure TMainForm.MenuItem71Click(Sender: TObject);
- begin
- ApplyMorphology(mpErode);
- end;
- procedure TMainForm.MenuItem72Click(Sender: TObject);
- begin
- ApplyMorphology(mpDilate);
- end;
- procedure TMainForm.MenuItem73Click(Sender: TObject);
- begin
- ApplyMorphology(mpOpen);
- end;
- procedure TMainForm.MenuItem74Click(Sender: TObject);
- begin
- ApplyMorphology(mpClose);
- end;
- procedure TMainForm.MenuItem75Click(Sender: TObject);
- begin
- ApplyPointTransform(ptLevelsLow);
- end;
- procedure TMainForm.MenuItem76Click(Sender: TObject);
- begin
- ApplyPointTransform(ptLevelsHigh);
- end;
- procedure TMainForm.MenuItem78Click(Sender: TObject);
- begin
- ApplyPointTransform(ptAlphaPreMult);
- end;
- procedure TMainForm.MenuItem79Click(Sender: TObject);
- begin
- ApplyPointTransform(ptAlphaUnPreMult);
- end;
- procedure TMainForm.MenuItem7Click(Sender: TObject);
- begin
- Close;
- end;
- procedure TMainForm.OpenFile(const FileName: string);
- var
- T: Int64;
- begin
- FFileName := FileName;
- try
- T := GetTimeMicroseconds;
- GlobalMetadata.ClearMetaItems;
- FImage.LoadMultiFromFile(FileName);
- FFileSize := FileSize(FileName);
- BuildImageTree;
- GlobalMetadata.CopyLoadedMetaItemsForSaving;
- MeasureTime(Format('File %s opened in:', [ExtractFileName(FileName)]), T);
- except
- MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
- FImage.CreateFromParams(32, 32, ifA8R8G8B8, 1);
- TreeImage.Items.Clear;
- end;
- SelectSubImage(0);
- end;
- procedure TMainForm.BuildImageTree;
- var
- Root, Node: TTreeNode;
- I: PtrInt;
- Lab: string;
- Data: TImageData;
- begin
- TreeImage.Items.Clear;
- Lab := Format('%s (%d images)', [ExtractFileName(FFileName), FImage.ImageCount]);
- Root := TreeImage.Items.Add(nil, Lab);
- for I := 0 to FImage.ImageCount - 1 do
- begin
- Data := FImage.Images[I];
- Lab := Format('Img%.2d %dx%d %s', [I, Data.Width, Data.Height, GetFormatName(Data.Format)]);
- Node := TreeImage.Items.AddChild(Root, Lab);
- Node.Data := Pointer(I);
- end;
- end;
- procedure TMainForm.SaveFile(const FileName: string);
- var
- T: Int64;
- begin
- try
- T := GetTimeMicroseconds;
- FImage.SaveMultiToFile(FileName);
- MeasureTime(Format('File %s saved in:', [ExtractFileName(FileName)]), T);
- except
- MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
- end;
- end;
- procedure TMainForm.SelectSubImage(Index: LongInt);
- begin
- FImage.ActiveImage := Index;
- MenuItemActSubImage.Caption := Format('Active Subimage: %d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]);
- UpdateView(False);
- end;
- procedure TMainForm.UpdateView(RebuildTree: Boolean);
- begin
- Image.Picture.Graphic.Assign(FImage);
- if RebuildTree then
- BuildImageTree;
- end;
- procedure TMainForm.MeasureTime(const Msg: string; const OldTime: Int64);
- begin
- StatusBar.SimpleText := Format(' %s %.0n ms', [Msg, (GetTimeMicroseconds - OldTime) / 1000.0]);
- end;
- {
- File Notes:
- -- 0.80 Changes/Bug Fixes -----------------------------------
- - Added "Add images from file" menu item
- -- 0.77.1 Changes/Bug Fixes ---------------------------------
- - Writing metadata from loaded file when resaving.
- - Added Otsu Thresholding and Deskwing, reorganized some menus.
- - Added Lanczos filtering option to resize image functions.
- - Added option to convert data format of all subimages by default.
- - UI enhancements: added TreeView with image/subimage list,
- added StatusBar instead of simple Panel.
- -- 0.26.5 Changes/Bug Fixes ---------------------------------
- - You can drop file on the form to open it.
- - Added "Show Metadata" item to View menu + related functionality.
- -- 0.26.3 Changes/Bug Fixes ---------------------------------
- - Added Free Resize and Free Rotate functions to Manipulate menu.
- - Added premult/unpremult alpha point transforms.
- -- 0.26.1 Changes/Bug Fixes ---------------------------------
- - Added "show histogram" menu item and functionality.
- - Added new Colors submenu with "set channel set value" commands.
- - Added Canvas.AdjustColorLevels example.
- -- 0.25.0 Changes/Bug Fixes ---------------------------------
- - Added binary morphology operations.
- - Added point transforms and non-linear filters.
- -- 0.24.1 Changes/Bug Fixes ---------------------------------
- - Added status bar which shows times taken by some oprations.
- - Reworked manipulation commands to get rid of UpdateView calls
- everywhere.
- - With Lazarus 0.9.24 images are now displayed with
- proper transparency (those with alpha). Also it doesn't
- screw up some images with 'Fit to window' so that is now
- default.
- -- 0.23 Changes/Bug Fixes -----------------------------------
- - Catches exceptions during file load/save.
- -- 0.21 Changes/Bug Fixes -----------------------------------
- - Save As... now saves all images levels instead of just current one.
- - Added XP controls manifest to resource file.
- - Added new filters to Effects menu.
- -- 0.19 Changes/Bug Fixes -----------------------------------
- - you can now open image in Imager from shell by passing
- path to image as parameter: 'LCLImager /home/myimage.jpg'
- - added Reload from File menu to reload image from disk
- (poor man's Undo)
- - added Effects menu with some convolution filters
- - added support for displaying of multi images
- -- 0.17 Changes/Bug Fixes -----------------------------------
- - added Nearest, Bilinear, and Bicubic filter options to
- Resize To 50/200% menu items
- - better handling of file exts when using save dialog
- - added rotations to Manipulate menu
- - now works well in Linux too
- -- 0.15 Changes/Bug Fixes -----------------------------------
- - created
- }
- end.
|