| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305 |
- {
- Vampyre Imaging Library Demo
- LCL Imager (ObjectPascal, high level/component sets/canvas, Win32/Linux/macOS)
- tested in Lazarus 1.8.4 (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,
- 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 := ' - OSX';
- {$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
- OpenFile(GetDataDir + PathDelim + '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.GammaCorection(1.2, 1.2, 1.2);
- ptDecGamma: FImageCanvas.GammaCorection(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.
|