mainunit.pas 37 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306
  1. {
  2. Vampyre Imaging Library Demo
  3. LCL Imager (ObjectPascal, high level/component sets/canvas, Win32/Linux/macOS)
  4. tested in Lazarus 2.2.0 (Windows; Linux: Gtk2, Qt; macOS: Carbon, Cocoa)
  5. written by Marek Mauder
  6. Simple image manipulator program which shows usage of Imaging VCL/LCL
  7. classes (TImagingGraphic and its descendants) to display images on form.
  8. It also uses high level image classes and some low level functions.
  9. Demo uses TMultiImage class to store images (loaded from one file - MNG, DDS)
  10. which can be modified by user. After each modification image
  11. is assigned to TImagingBitmap class which provides visualization
  12. on the app form (using standard TImage component). Demo also uses new
  13. TImagingCanvas class to do some effects.
  14. In File menu you can open new image and save the current one. Items in
  15. View menu provide information about the current image and controls
  16. how it is displayed. You can also select next and previous subimage if loaded file
  17. contains more than one image. Format menu allows you to convert image
  18. to different image data formats supported by Imaging. Manipulate
  19. menu allows you to enlarge/shrink/flip/mirror/swap channels/other
  20. of the current image. Effects menu allows you to apply various effects to the
  21. image (provided by TImagingCanvas).
  22. }
  23. unit MainUnit;
  24. {$I ImagingOptions.inc}
  25. interface
  26. uses
  27. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Variants,
  28. Menus, ExtCtrls, ExtDlgs, DemoUtils, AboutUnit, ActnList, StdCtrls, ComCtrls,
  29. PairSplitter, FileUtil,
  30. ImagingTypes,
  31. Imaging,
  32. ImagingClasses,
  33. ImagingComponents,
  34. ImagingCanvases,
  35. ImagingBinary,
  36. ImagingColors,
  37. ImagingUtility;
  38. type
  39. TManipulationType = (mtFlip, mtMirror, mtRotate90CW, mtRotate90CCW,
  40. mtFreeRotate, mtResize50, mtResize200, mtFreeResize,
  41. mtSwapRB, mtSwapRG, mtSwapGB, mtReduce1024,
  42. mtReduce256, mtReduce64, mtReduce16, mtReduce2);
  43. TPointTransform = (ptInvert, ptIncContrast, ptDecContrast, ptIncBrightness,
  44. ptDecBrightness, ptIncGamma, ptDecGamma, ptThreshold, ptLevelsLow,
  45. ptLevelsHigh, ptAlphaPreMult, ptAlphaUnPreMult);
  46. TNonLinearFilter = (nfMedian, nfMin, nfMax);
  47. TMorphology = (mpErode, mpDilate, mpOpen, mpClose);
  48. TAdditionalOp = (aoOtsuThreshold, aoDeskew);
  49. { TMainForm }
  50. TMainForm = class(TForm)
  51. ActViewInfo: TAction;
  52. ActViewFitToWindow: TAction;
  53. ActViewActualSize: TAction;
  54. ActionList: TActionList;
  55. Image: TImage;
  56. MainMenu: TMainMenu;
  57. MenuItem1: TMenuItem;
  58. MenuItem10: TMenuItem;
  59. MenuItem11: TMenuItem;
  60. MenuItem12: TMenuItem;
  61. MenuItem13: TMenuItem;
  62. MenuItem14: TMenuItem;
  63. MenuItem15: TMenuItem;
  64. MenuItem16: TMenuItem;
  65. MenuItem17: TMenuItem;
  66. FormatItem: TMenuItem;
  67. MenuItem18: TMenuItem;
  68. MenuItem19: TMenuItem;
  69. MenuItem2: TMenuItem;
  70. MenuItem20: TMenuItem;
  71. MenuItem21: TMenuItem;
  72. MenuItem22: TMenuItem;
  73. MenuItem23: TMenuItem;
  74. MenuItem24: TMenuItem;
  75. MenuItem25: TMenuItem;
  76. MenuItem26: TMenuItem;
  77. MenuItem27: TMenuItem;
  78. MenuItem28: TMenuItem;
  79. MenuItem29: TMenuItem;
  80. MenuItem3: TMenuItem;
  81. MenuItem30: TMenuItem;
  82. MenuItem31: TMenuItem;
  83. MenuItem32: TMenuItem;
  84. MenuItem33: TMenuItem;
  85. MenuItem36: TMenuItem;
  86. MenuItem37: TMenuItem;
  87. MenuItem38: TMenuItem;
  88. MenuItem39: TMenuItem;
  89. MenuItem40: TMenuItem;
  90. MenuItem41: TMenuItem;
  91. MenuItem42: TMenuItem;
  92. MenuItem43: TMenuItem;
  93. MenuItem44: TMenuItem;
  94. MenuItem45: TMenuItem;
  95. MenuItem46: TMenuItem;
  96. MenuItem47: TMenuItem;
  97. MenuItem48: TMenuItem;
  98. MenuItem49: TMenuItem;
  99. MenuItem50: TMenuItem;
  100. MenuItem51: TMenuItem;
  101. MenuItem52: TMenuItem;
  102. MenuItem53: TMenuItem;
  103. MenuItem54: TMenuItem;
  104. MenuItem55: TMenuItem;
  105. MenuItem56: TMenuItem;
  106. MenuItem57: TMenuItem;
  107. MenuItem58: TMenuItem;
  108. MenuItem59: TMenuItem;
  109. MenuItem60: TMenuItem;
  110. MenuItem61: TMenuItem;
  111. MenuItem62: TMenuItem;
  112. MenuItem63: TMenuItem;
  113. MenuItem64: TMenuItem;
  114. MenuItem65: TMenuItem;
  115. MenuItem66: TMenuItem;
  116. MenuItem67: TMenuItem;
  117. MenuItem68: TMenuItem;
  118. MenuItem69: TMenuItem;
  119. MenuItem70: TMenuItem;
  120. MenuItem91: TMenuItem;
  121. MenuItem92: TMenuItem;
  122. MenuItem93: TMenuItem;
  123. MIMorphology: TMenuItem;
  124. MenuItem71: TMenuItem;
  125. MenuItem72: TMenuItem;
  126. MenuItem73: TMenuItem;
  127. MenuItem74: TMenuItem;
  128. MenuItem75: TMenuItem;
  129. MenuItem76: TMenuItem;
  130. MenuItem77: TMenuItem;
  131. AlphaItem: TMenuItem;
  132. MenuItem78: TMenuItem;
  133. MenuItem79: TMenuItem;
  134. MenuItem80: TMenuItem;
  135. MenuItem81: TMenuItem;
  136. MenuItem83: TMenuItem;
  137. MenuItem84: TMenuItem;
  138. MenuItem85: TMenuItem;
  139. MenuItem86: TMenuItem;
  140. MenuItem87: TMenuItem;
  141. MenuItem88: TMenuItem;
  142. MenuItem89: TMenuItem;
  143. MenuItem90: TMenuItem;
  144. MenuItemConvertAll: TMenuItem;
  145. MIAdditional: TMenuItem;
  146. PairSplitter: TPairSplitter;
  147. PairSplitterSideLeft: TPairSplitterSide;
  148. PairSplitterSideRight: TPairSplitterSide;
  149. RedItem: TMenuItem;
  150. GreenItem: TMenuItem;
  151. BlueItem: TMenuItem;
  152. MenuItem82: TMenuItem;
  153. MenuItemActSubImage: TMenuItem;
  154. MenuItem34: TMenuItem;
  155. MenuItem35: TMenuItem;
  156. MenuItem4: TMenuItem;
  157. MenuItem5: TMenuItem;
  158. MenuItem6: TMenuItem;
  159. MenuItem7: TMenuItem;
  160. MenuItem8: TMenuItem;
  161. MenuItem9: TMenuItem;
  162. OpenDialog: TOpenPictureDialog;
  163. SaveDialog: TSavePictureDialog;
  164. StatusBar: TStatusBar;
  165. TreeImage: TTreeView;
  166. procedure ActViewFitToWindowExecute(Sender: TObject);
  167. procedure ActViewInfoExecute(Sender: TObject);
  168. procedure ActViewActualSizeExecute(Sender: TObject);
  169. procedure FormCreate(Sender: TObject);
  170. procedure FormDestroy(Sender: TObject);
  171. procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
  172. procedure FormShow(Sender: TObject);
  173. procedure ImageClick(Sender: TObject);
  174. procedure MenuItem10Click(Sender: TObject);
  175. procedure MenuItem12Click(Sender: TObject);
  176. procedure MenuItem13Click(Sender: TObject);
  177. procedure MenuItem14Click(Sender: TObject);
  178. procedure MenuItem15Click(Sender: TObject);
  179. procedure MenuItem18Click(Sender: TObject);
  180. procedure MenuItem19Click(Sender: TObject);
  181. procedure MenuItem20Click(Sender: TObject);
  182. procedure MenuItem23Click(Sender: TObject);
  183. procedure MenuItem24Click(Sender: TObject);
  184. procedure MenuItem26Click(Sender: TObject);
  185. procedure MenuItem27Click(Sender: TObject);
  186. procedure MenuItem28Click(Sender: TObject);
  187. procedure MenuItem29Click(Sender: TObject);
  188. procedure MenuItem2Click(Sender: TObject);
  189. procedure MenuItem30Click(Sender: TObject);
  190. procedure MenuItem31Click(Sender: TObject);
  191. procedure MenuItem33Click(Sender: TObject);
  192. procedure MenuItem34Click(Sender: TObject);
  193. procedure MenuItem35Click(Sender: TObject);
  194. procedure MenuItem37Click(Sender: TObject);
  195. procedure MenuItem38Click(Sender: TObject);
  196. procedure MenuItem39Click(Sender: TObject);
  197. procedure MenuItem3Click(Sender: TObject);
  198. procedure MenuItem40Click(Sender: TObject);
  199. procedure MenuItem41Click(Sender: TObject);
  200. procedure MenuItem42Click(Sender: TObject);
  201. procedure MenuItem43Click(Sender: TObject);
  202. procedure MenuItem44Click(Sender: TObject);
  203. procedure MenuItem45Click(Sender: TObject);
  204. procedure MenuItem46Click(Sender: TObject);
  205. procedure MenuItem47Click(Sender: TObject);
  206. procedure MenuItem48Click(Sender: TObject);
  207. procedure MenuItem4Click(Sender: TObject);
  208. procedure MenuItem50Click(Sender: TObject);
  209. procedure MenuItem51Click(Sender: TObject);
  210. procedure MenuItem53Click(Sender: TObject);
  211. procedure MenuItem54Click(Sender: TObject);
  212. procedure MenuItem56Click(Sender: TObject);
  213. procedure MenuItem57Click(Sender: TObject);
  214. procedure MenuItem58Click(Sender: TObject);
  215. procedure MenuItem59Click(Sender: TObject);
  216. procedure MenuItem5Click(Sender: TObject);
  217. procedure MenuItem60Click(Sender: TObject);
  218. procedure MenuItem61Click(Sender: TObject);
  219. procedure MenuItem62Click(Sender: TObject);
  220. procedure MenuItem64Click(Sender: TObject);
  221. procedure MenuItem65Click(Sender: TObject);
  222. procedure MenuItem66Click(Sender: TObject);
  223. procedure MenuItem67Click(Sender: TObject);
  224. procedure MenuItem68Click(Sender: TObject);
  225. procedure MenuItem69Click(Sender: TObject);
  226. procedure MenuItem70Click(Sender: TObject);
  227. procedure MenuItem71Click(Sender: TObject);
  228. procedure MenuItem72Click(Sender: TObject);
  229. procedure MenuItem73Click(Sender: TObject);
  230. procedure MenuItem74Click(Sender: TObject);
  231. procedure MenuItem75Click(Sender: TObject);
  232. procedure MenuItem76Click(Sender: TObject);
  233. procedure MenuItem78Click(Sender: TObject);
  234. procedure MenuItem79Click(Sender: TObject);
  235. procedure MenuItem7Click(Sender: TObject);
  236. procedure FormatChangeClick(Sender: TObject);
  237. procedure ChannelSetClick(Sender: TObject);
  238. procedure MenuItem80Click(Sender: TObject);
  239. procedure MenuItem82Click(Sender: TObject);
  240. procedure MenuItem83Click(Sender: TObject);
  241. procedure MenuItem84Click(Sender: TObject);
  242. procedure MenuItem85Click(Sender: TObject);
  243. procedure MenuItem86Click(Sender: TObject);
  244. procedure MenuItem88Click(Sender: TObject);
  245. procedure MenuItem89Click(Sender: TObject);
  246. procedure MenuItem90Click(Sender: TObject);
  247. procedure MenuItem91Click(Sender: TObject);
  248. procedure MenuItem92Click(Sender: TObject);
  249. procedure TreeImageSelectionChanged(Sender: TObject);
  250. private
  251. FBitmap: TImagingBitmap;
  252. FImage: TMultiImage;
  253. FImageCanvas: TImagingCanvas;
  254. FFileName: string;
  255. FFileSize: Integer;
  256. FParam1, FParam2, FParam3: Integer;
  257. procedure OpenFile(const FileName: string);
  258. procedure SaveFile(const FileName: string);
  259. procedure SelectSubImage(Index: LongInt);
  260. procedure UpdateView(RebuildTree: Boolean);
  261. function CheckCanvasFormat: Boolean;
  262. procedure ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  263. procedure ApplyPointTransform(Transform: TPointTransform);
  264. procedure ApplyManipulation(ManipType: TManipulationType);
  265. procedure ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  266. procedure ApplyMorphology(MorphOp: TMorphology);
  267. procedure ApplyAdditionalOp(Op: TAdditionalOp);
  268. procedure MeasureTime(const Msg: string; const OldTime: Int64);
  269. procedure FreeResizeInput;
  270. function InputInteger(const ACaption, APrompt: string; var Value: Integer): Boolean;
  271. procedure BuildImageTree;
  272. public
  273. end;
  274. const
  275. SWindowTitle = 'LCL Imager - Vampyre Imaging Library %s Demo';
  276. var
  277. MainForm: TMainForm;
  278. implementation
  279. {$R *.lfm}
  280. {$IFDEF MSWINDOWS}
  281. uses
  282. Windows;
  283. {$ENDIF}
  284. { TMainForm }
  285. procedure TMainForm.FormCreate(Sender: TObject);
  286. var
  287. Item: TMenuItem;
  288. Fmt: TImageFormat;
  289. Info: TImageFormatInfo;
  290. Platform: string;
  291. function Clone(AItem: TMenuItem): TMenuItem;
  292. begin
  293. Result := TMenuItem.Create(MainMenu);
  294. Result.Caption := AItem.Caption;
  295. Result.Tag := AItem.Tag;
  296. Result.OnClick := AItem.OnClick;;
  297. end;
  298. procedure AddSetChannelItem(const Caption: string; Value: Integer);
  299. begin
  300. Item := TMenuItem.Create(MainMenu);
  301. Item.Caption := Caption;
  302. Item.Tag := Value;
  303. Item.OnClick := ChannelSetClick;
  304. AlphaItem.Add(Item);
  305. RedItem.Add(Clone(Item));
  306. GreenItem.Add(Clone(Item));
  307. BlueItem.Add(Clone(Item));
  308. end;
  309. begin
  310. Platform := '';
  311. {$IF Defined(WIN64)}
  312. Platform := ' - WIN64';
  313. {$ELSEIF Defined(WIN32)}
  314. Platform := ' - WIN32';
  315. {$ELSEIF Defined(LINUX)}
  316. Platform := ' - Linux';
  317. {$ELSEIF Defined(DARWIN)}
  318. Platform := ' - macOS';
  319. {$ENDIF}
  320. Caption := Format(SWindowTitle, [Imaging.GetVersionStr]) + Platform;
  321. { Source image and Image's graphic are created and
  322. default image is opened.}
  323. FImage := TMultiImage.Create;
  324. FBitmap := TImagingBitmap.Create;
  325. Image.Picture.Graphic := FBitmap;
  326. FImageCanvas := TImagingCanvas.Create;
  327. { This builds Format submenu containing all possible
  328. image data formats (it dos not start at Low(TImageFormat)
  329. because there are some helper formats). Format for each item
  330. is stored in its Tag for later use in OnClick event.}
  331. for Fmt := ifIndex8 to High(TImageFormat) do
  332. begin
  333. GetImageFormatInfo(Fmt, Info);
  334. if Info.Name <> '' then
  335. begin
  336. Item := TMenuItem.Create(MainMenu);
  337. Item.Caption := Info.Name;
  338. Item.Tag := Ord(Fmt);
  339. Item.OnClick := FormatChangeClick;
  340. FormatItem.Add(Item);
  341. end;
  342. end;
  343. AddSetChannelItem('Set to 5%', 12);
  344. AddSetChannelItem('Set to 50%', 128);
  345. AddSetChannelItem('Set to 100%', 255);
  346. // Set 'Fit to window' mode
  347. ActViewFitToWindowExecute(Self);
  348. if (ParamCount > 0) and FileExists(ParamStr(1)) then
  349. OpenFile(ParamStr(1))
  350. else if FileExists(FileNameInDataDir('Tigers.jpg')) then
  351. OpenFile(FileNameInDataDir('Tigers.jpg'));
  352. end;
  353. procedure TMainForm.MenuItem10Click(Sender: TObject);
  354. begin
  355. AboutForm.ShowModal;
  356. end;
  357. procedure TMainForm.MenuItem12Click(Sender: TObject);
  358. begin
  359. ApplyManipulation(mtSwapRB);
  360. end;
  361. procedure TMainForm.MenuItem13Click(Sender: TObject);
  362. begin
  363. ApplyManipulation(mtSwapRG);
  364. end;
  365. procedure TMainForm.MenuItem14Click(Sender: TObject);
  366. begin
  367. ApplyManipulation(mtSwapGB);
  368. end;
  369. procedure TMainForm.MenuItem15Click(Sender: TObject);
  370. begin
  371. ApplyManipulation(mtReduce1024);
  372. end;
  373. procedure TMainForm.MenuItem18Click(Sender: TObject);
  374. begin
  375. ApplyManipulation(mtReduce256);
  376. end;
  377. procedure TMainForm.MenuItem19Click(Sender: TObject);
  378. begin
  379. ApplyManipulation(mtReduce64);
  380. end;
  381. procedure TMainForm.MenuItem20Click(Sender: TObject);
  382. begin
  383. ApplyManipulation(mtReduce16);
  384. end;
  385. procedure TMainForm.MenuItem4Click(Sender: TObject);
  386. begin
  387. ApplyManipulation(mtMirror);
  388. end;
  389. procedure TMainForm.MenuItem23Click(Sender: TObject);
  390. begin
  391. ApplyManipulation(mtRotate90CW);
  392. end;
  393. procedure TMainForm.MenuItem24Click(Sender: TObject);
  394. begin
  395. ApplyManipulation(mtRotate90CCW);
  396. end;
  397. procedure TMainForm.MenuItem26Click(Sender: TObject);
  398. begin
  399. FParam1 := Ord(rfNearest);
  400. ApplyManipulation(mtResize50);
  401. end;
  402. procedure TMainForm.MenuItem27Click(Sender: TObject);
  403. begin
  404. FParam1 := Ord(rfBilinear);
  405. ApplyManipulation(mtResize50);
  406. end;
  407. procedure TMainForm.MenuItem28Click(Sender: TObject);
  408. begin
  409. FParam1 := Ord(rfBicubic);
  410. ApplyManipulation(mtResize50);
  411. end;
  412. procedure TMainForm.MenuItem29Click(Sender: TObject);
  413. begin
  414. FParam1 := Ord(rfNearest);
  415. ApplyManipulation(mtResize200);
  416. end;
  417. procedure TMainForm.MenuItem30Click(Sender: TObject);
  418. begin
  419. FParam1 := Ord(rfBilinear);
  420. ApplyManipulation(mtResize200);
  421. end;
  422. procedure TMainForm.MenuItem31Click(Sender: TObject);
  423. begin
  424. FParam1 := Ord(rfBicubic);
  425. ApplyManipulation(mtResize200);
  426. end;
  427. procedure TMainForm.MenuItem2Click(Sender: TObject);
  428. begin
  429. ApplyManipulation(mtFlip);
  430. end;
  431. procedure TMainForm.MenuItem33Click(Sender: TObject);
  432. begin
  433. ApplyManipulation(mtReduce2);
  434. end;
  435. procedure TMainForm.MenuItem37Click(Sender: TObject);
  436. begin
  437. ApplyConvolution(@FilterGaussian3x3, 3, False);
  438. end;
  439. procedure TMainForm.MenuItem38Click(Sender: TObject);
  440. begin
  441. ApplyConvolution(@FilterGaussian5x5, 5, False);
  442. end;
  443. procedure TMainForm.MenuItem39Click(Sender: TObject);
  444. begin
  445. ApplyConvolution(@FilterSharpen3x3, 3, False);
  446. end;
  447. procedure TMainForm.MenuItem40Click(Sender: TObject);
  448. begin
  449. ApplyConvolution(@FilterSharpen5x5, 5, False);
  450. end;
  451. procedure TMainForm.MenuItem41Click(Sender: TObject);
  452. begin
  453. ApplyConvolution(@FilterLaplace5x5, 5, True);
  454. end;
  455. procedure TMainForm.MenuItem42Click(Sender: TObject);
  456. begin
  457. ApplyConvolution(@FilterSobelHorz3x3, 3, True);
  458. end;
  459. procedure TMainForm.MenuItem43Click(Sender: TObject);
  460. begin
  461. ApplyConvolution(@FilterSobelVert3x3, 3, True);
  462. end;
  463. procedure TMainForm.MenuItem44Click(Sender: TObject);
  464. begin
  465. OpenFile(FFileName);
  466. end;
  467. procedure TMainForm.MenuItem45Click(Sender: TObject);
  468. begin
  469. ApplyConvolution(@FilterGlow5x5, 5, False);
  470. end;
  471. procedure TMainForm.MenuItem46Click(Sender: TObject);
  472. begin
  473. ApplyConvolution(@FilterEmboss3x3, 3, True);
  474. end;
  475. procedure TMainForm.MenuItem47Click(Sender: TObject);
  476. begin
  477. ApplyPointTransform(ptIncContrast);
  478. end;
  479. procedure TMainForm.MenuItem48Click(Sender: TObject);
  480. begin
  481. ApplyConvolution(@FilterEdgeEnhance3x3, 3, False);
  482. end;
  483. procedure TMainForm.MenuItem50Click(Sender: TObject);
  484. begin
  485. ApplyConvolution(@FilterPrewittHorz3x3, 3, True);
  486. end;
  487. procedure TMainForm.MenuItem51Click(Sender: TObject);
  488. begin
  489. ApplyConvolution(@FilterKirshHorz3x3, 3, True);
  490. end;
  491. procedure TMainForm.MenuItem53Click(Sender: TObject);
  492. begin
  493. ApplyConvolution(@FilterPrewittVert3x3, 3, True);
  494. end;
  495. procedure TMainForm.MenuItem54Click(Sender: TObject);
  496. begin
  497. ApplyConvolution(@FilterKirshVert3x3, 3, True);
  498. end;
  499. procedure TMainForm.MenuItem56Click(Sender: TObject);
  500. begin
  501. ApplyPointTransform(ptInvert);
  502. end;
  503. procedure TMainForm.MenuItem57Click(Sender: TObject);
  504. begin
  505. ApplyPointTransform(ptDecContrast);
  506. end;
  507. procedure TMainForm.MenuItem58Click(Sender: TObject);
  508. begin
  509. ApplyPointTransform(ptIncBrightness);
  510. end;
  511. procedure TMainForm.MenuItem59Click(Sender: TObject);
  512. begin
  513. ApplyPointTransform(ptDecBrightness);
  514. end;
  515. procedure TMainForm.MenuItem34Click(Sender: TObject);
  516. begin
  517. SelectSubImage(FImage.ActiveImage + 1);
  518. end;
  519. procedure TMainForm.MenuItem35Click(Sender: TObject);
  520. begin
  521. SelectSubImage(FImage.ActiveImage - 1);
  522. end;
  523. function TMainForm.CheckCanvasFormat: Boolean;
  524. begin
  525. Result := FImage.Format in FImageCanvas.GetSupportedFormats;
  526. if not Result then
  527. MessageDlg('Image is in format that is not supported by TImagingCanvas.', mtError, [mbOK], 0);
  528. end;
  529. procedure TMainForm.ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  530. var
  531. T: Int64;
  532. begin
  533. if CheckCanvasFormat then
  534. begin
  535. FImageCanvas.CreateForImage(FImage);
  536. T := GetTimeMicroseconds;
  537. if NeedsBlur then
  538. FImageCanvas.ApplyConvolution3x3(FilterGaussian3x3);
  539. if Size = 3 then
  540. FImageCanvas.ApplyConvolution3x3(TConvolutionFilter3x3(Kernel^))
  541. else
  542. FImageCanvas.ApplyConvolution5x5(TConvolutionFilter5x5(Kernel^));
  543. MeasureTime('Image convolved in:', T);
  544. UpdateView(False);
  545. end;
  546. end;
  547. procedure TMainForm.ApplyPointTransform(Transform: TPointTransform);
  548. var
  549. T: Int64;
  550. begin
  551. if CheckCanvasFormat then
  552. begin
  553. FImageCanvas.CreateForImage(FImage);
  554. T := GetTimeMicroseconds;
  555. case Transform of
  556. ptInvert: FImageCanvas.InvertColors;
  557. ptIncContrast: FImageCanvas.ModifyContrastBrightness(20, 0);
  558. ptDecContrast: FImageCanvas.ModifyContrastBrightness(-20, 0);
  559. ptIncBrightness: FImageCanvas.ModifyContrastBrightness(0, 20);
  560. ptDecBrightness: FImageCanvas.ModifyContrastBrightness(0, -20);
  561. ptIncGamma: FImageCanvas.GammaCorrection(1.2, 1.2, 1.2);
  562. ptDecGamma: FImageCanvas.GammaCorrection(0.8, 0.8, 0.8);
  563. ptThreshold: FImageCanvas.Threshold(0.5, 0.5, 0.5);
  564. ptLevelsLow: FImageCanvas.AdjustColorLevels(0.0, 0.5, 1.0);
  565. ptLevelsHigh: FImageCanvas.AdjustColorLevels(0.35, 1.0, 0.9);
  566. ptAlphaPreMult: FImageCanvas.PremultiplyAlpha;
  567. ptAlphaUnPreMult: FImageCanvas.UnPremultiplyAlpha;
  568. end;
  569. MeasureTime('Point transform done in:', T);
  570. UpdateView(False);
  571. end;
  572. end;
  573. procedure TMainForm.ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  574. var
  575. T: Int64;
  576. begin
  577. if CheckCanvasFormat then
  578. begin
  579. FImageCanvas.CreateForImage(FImage);
  580. T := GetTimeMicroseconds;
  581. case FilterType of
  582. nfMedian: FImageCanvas.ApplyMedianFilter(FilterSize);
  583. nfMin: FImageCanvas.ApplyMinFilter(FilterSize);
  584. nfMax: FImageCanvas.ApplyMaxFilter(FilterSize);
  585. end;
  586. MeasureTime('Point transform done in:', T);
  587. UpdateView(False);
  588. end;
  589. end;
  590. procedure TMainForm.ApplyMorphology(MorphOp: TMorphology);
  591. var
  592. T: Int64;
  593. Strel: TStructElement;
  594. begin
  595. T := GetTimeMicroseconds;
  596. FImage.Format := ifGray8;
  597. OtsuThresholding(FImage.ImageDataPointer^);
  598. SetLength(Strel, 3, 3);
  599. Strel[0, 0] := 0;
  600. Strel[1, 0] := 1;
  601. Strel[2, 0] := 0;
  602. Strel[0, 1] := 1;
  603. Strel[1, 1] := 1;
  604. Strel[2, 1] := 1;
  605. Strel[0, 2] := 0;
  606. Strel[1, 2] := 1;
  607. Strel[2, 2] := 0;
  608. case MorphOp of
  609. mpErode: Morphology(FImage.ImageDataPointer^, Strel, moErode);
  610. mpDilate: Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  611. mpOpen:
  612. begin
  613. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  614. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  615. end;
  616. mpClose:
  617. begin
  618. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  619. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  620. end;
  621. end;
  622. MeasureTime('Morphology operation applied in:', T);
  623. UpdateView(True);
  624. end;
  625. procedure TMainForm.ApplyAdditionalOp(Op: TAdditionalOp);
  626. var
  627. T: Int64;
  628. begin
  629. T := GetTimeMicroseconds;
  630. case Op of
  631. aoOtsuThreshold:
  632. begin
  633. FImage.Format := ifGray8;
  634. OtsuThresholding(FImage.ImageDataPointer^, True);
  635. end;
  636. aoDeskew: DeskewImage(FImage.ImageDataPointer^);
  637. end;
  638. MeasureTime('Operation completed in:', T);
  639. UpdateView(False);
  640. end;
  641. procedure TMainForm.ApplyManipulation(ManipType: TManipulationType);
  642. var
  643. T: Int64;
  644. OldFmt: TImageFormat;
  645. OldSize: Integer;
  646. RebuildTree: Boolean;
  647. begin
  648. OldFmt := FImage.Format;
  649. OldSize := FImage.Size;
  650. T := GetTimeMicroseconds;
  651. case ManipType of
  652. mtFlip: FImage.Flip;
  653. mtMirror: FImage.Mirror;
  654. mtRotate90CW: FImage.Rotate(-90);
  655. mtRotate90CCW: FImage.Rotate(90);
  656. mtFreeRotate: FImage.Rotate(FParam1);
  657. mtResize50: FImage.Resize(FImage.Width div 2, FImage.Height div 2, TResizeFilter(FParam1));
  658. mtResize200: FImage.Resize(FImage.Width * 2, FImage.Height * 2, TResizeFilter(FParam1));
  659. mtFreeResize: FImage.Resize(FParam2, FParam3, TResizeFilter(FParam1));
  660. mtSwapRB: FImage.SwapChannels(ChannelRed, ChannelBlue);
  661. mtSwapRG: FImage.SwapChannels(ChannelRed, ChannelGreen);
  662. mtSwapGB: FImage.SwapChannels(ChannelGreen, ChannelBlue);
  663. mtReduce1024: ReduceColors(FImage.ImageDataPointer^, 1024);
  664. mtReduce256: ReduceColors(FImage.ImageDataPointer^, 256);
  665. mtReduce64: ReduceColors(FImage.ImageDataPointer^, 64);
  666. mtReduce16: ReduceColors(FImage.ImageDataPointer^, 16);
  667. mtReduce2: ReduceColors(FImage.ImageDataPointer^, 2);
  668. end;
  669. MeasureTime('Image manipulated in:', T);
  670. RebuildTree := (FImage.Format <> OldFmt) or (FImage.Size <> OldSize);
  671. UpdateView(RebuildTree);
  672. end;
  673. procedure TMainForm.FormatChangeClick(Sender: TObject);
  674. var
  675. T: Int64;
  676. Fmt: TImageFormat;
  677. begin
  678. with Sender as TMenuItem do
  679. begin
  680. T := GetTimeMicroseconds;
  681. Fmt := TImageFormat(Tag);
  682. if MenuItemConvertAll.Checked then
  683. FImage.ConvertImages(Fmt)
  684. else
  685. FImage.Format := Fmt;
  686. MeasureTime('Image converted in:', T);
  687. UpdateView(True);
  688. end;
  689. end;
  690. procedure TMainForm.ChannelSetClick(Sender: TObject);
  691. var
  692. T: Int64;
  693. Canvas: TImagingCanvas;
  694. ChanId: Integer;
  695. begin
  696. if CheckCanvasFormat then
  697. with Sender as TMenuItem do
  698. begin
  699. case Parent.Caption[1] of
  700. 'A': ChanId := ChannelAlpha;
  701. 'R': ChanId := ChannelRed;
  702. 'G': ChanId := ChannelGreen;
  703. 'B': ChanId := ChannelBlue;
  704. else
  705. ChanId := ChannelRed;
  706. end;
  707. Canvas := TImagingCanvas.CreateForImage(FImage);
  708. T := GetTimeMicroseconds;
  709. Canvas.FillChannel(ChanId, Tag);
  710. MeasureTime('Channel filled in:', T);
  711. Canvas.Free;
  712. UpdateView(False);
  713. end;
  714. end;
  715. procedure TMainForm.MenuItem80Click(Sender: TObject);
  716. begin
  717. if InputInteger('Free Rotate', 'Enter angle in degrees:', FParam1) then
  718. ApplyManipulation(mtFreeRotate);
  719. end;
  720. procedure TMainForm.FreeResizeInput;
  721. begin
  722. if InputInteger('Free Resize', 'Enter width in pixels', FParam2) and
  723. InputInteger('Free Resize', 'Enter height in pixels', FParam3) then
  724. begin
  725. ApplyManipulation(mtFreeResize);
  726. end;
  727. end;
  728. function TMainForm.InputInteger(const ACaption, APrompt: string;
  729. var Value: Integer): Boolean;
  730. var
  731. StrVal: string;
  732. begin
  733. Result := False;
  734. StrVal := '';
  735. if Dialogs.InputQuery(ACaption, APrompt, StrVal) then
  736. begin
  737. if TryStrToInt(StrVal, Value) then
  738. Exit(True)
  739. else
  740. MessageDlg('Cannot convert input to number', mtError, [mbOK], 0);
  741. end;
  742. end;
  743. procedure TMainForm.MenuItem82Click(Sender: TObject);
  744. var
  745. T: Int64;
  746. Canvas: TImagingCanvas;
  747. Red, Green, Blue, Alpha, Gray: THistogramArray;
  748. I, MaxPixels: Integer;
  749. Factor: Single;
  750. procedure VisualizeHistogram(const Histo: THistogramArray; Color: TColor32; Offset: Integer);
  751. var
  752. I: Integer;
  753. begin
  754. Canvas.PenColor32 := Color;
  755. for I := 0 to 255 do
  756. Canvas.VertLine(I + Offset, 256 - Round(Histo[I] * Factor), 255);
  757. end;
  758. begin
  759. if CheckCanvasFormat then
  760. begin
  761. Canvas := TImagingCanvas.CreateForImage(FImage);
  762. T := GetTimeMicroseconds;
  763. Canvas.GetHistogram(Red, Green, Blue, Alpha, Gray);
  764. MeasureTime('Histograms computed in:', T);
  765. FImage.ActiveImage := FImage.AddImage(1024, 256, ifA8R8G8B8);
  766. Canvas.CreateForImage(FImage);
  767. Canvas.FillColor32 := pcBlack;
  768. Canvas.FillRect(FImage.BoundsRect);
  769. MaxPixels := 0;
  770. for I := 0 to 255 do
  771. if Red[I] > MaxPixels then MaxPixels := Red[I];
  772. for I := 0 to 255 do
  773. if Green[I] > MaxPixels then MaxPixels := Green[I];
  774. for I := 0 to 255 do
  775. if Blue[I] > MaxPixels then MaxPixels := Blue[I];
  776. for I := 0 to 255 do
  777. if Gray[I] > MaxPixels then MaxPixels := Gray[I];
  778. Factor := 256 / MaxPixels;
  779. VisualizeHistogram(Red, pcRed, 0);
  780. VisualizeHistogram(Green, pcGreen, 256);
  781. VisualizeHistogram(Blue, pcBlue, 512);
  782. VisualizeHistogram(Gray, pcGray, 768);
  783. Canvas.Free;
  784. UpdateView(True);
  785. end;
  786. end;
  787. procedure TMainForm.MenuItem83Click(Sender: TObject);
  788. begin
  789. FParam1 := Ord(rfNearest);
  790. FreeResizeInput;
  791. end;
  792. procedure TMainForm.MenuItem84Click(Sender: TObject);
  793. begin
  794. FParam1 := Ord(rfBilinear);
  795. FreeResizeInput;
  796. end;
  797. procedure TMainForm.MenuItem85Click(Sender: TObject);
  798. begin
  799. FParam1 := Ord(rfBicubic);
  800. FreeResizeInput;
  801. end;
  802. procedure TMainForm.MenuItem86Click(Sender: TObject);
  803. var
  804. Form: TForm;
  805. Memo: TMemo;
  806. I: Integer;
  807. Item: TMetadataItem;
  808. S: string;
  809. begin
  810. Form := TForm.Create(Self);
  811. Form.BorderIcons := [biSystemMenu];
  812. Form.Caption := 'Detected Image Metadata';
  813. Form.Position := poOwnerFormCenter;
  814. Form.Width := 512;
  815. Form.Height := 512;
  816. Memo := TMemo.Create(Form);
  817. Memo.Parent := Form;
  818. Memo.Align := alClient;
  819. Memo.ReadOnly := True;
  820. Memo.ScrollBars := ssVertical;
  821. if GlobalMetadata.MetaItemCount > 0 then
  822. begin
  823. for I := 0 to GlobalMetadata.MetaItemCount - 1 do
  824. begin
  825. Item := GlobalMetadata.MetaItemsByIdx[I];
  826. S := Format('%s (idx: %d, type: %s): %s', [Item.Id, Item.ImageIndex,
  827. VarTypeAsText(VarType(Item.Value)), VarToStrDef(Item.Value, 'couldn''t convert Variant to string')]);
  828. Memo.Lines.Add(S);
  829. end;
  830. end
  831. else
  832. Memo.Lines.Add('No metadata loaded for this image');
  833. Form.ShowModal;
  834. Form.Free;
  835. end;
  836. procedure TMainForm.MenuItem88Click(Sender: TObject);
  837. begin
  838. FParam1 := Ord(rfLanczos);
  839. ApplyManipulation(mtResize50);
  840. end;
  841. procedure TMainForm.MenuItem89Click(Sender: TObject);
  842. begin
  843. FParam1 := Ord(rfLanczos);
  844. ApplyManipulation(mtResize200);
  845. end;
  846. procedure TMainForm.MenuItem90Click(Sender: TObject);
  847. begin
  848. FParam1 := Ord(rfLanczos);
  849. FreeResizeInput;
  850. end;
  851. procedure TMainForm.MenuItem91Click(Sender: TObject);
  852. begin
  853. ApplyAdditionalOp(aoDeskew);
  854. end;
  855. procedure TMainForm.MenuItem92Click(Sender: TObject);
  856. var
  857. Images: TMultiImage;
  858. begin
  859. OpenDialog.Filter := GetImageFileFormatsFilter(True);
  860. if OpenDialog.Execute then
  861. begin
  862. Images := TMultiImage.Create;
  863. try
  864. Images.LoadMultiFromFile(OpenDialog.FileName);
  865. FImage.AddImages(Images.DataArray);
  866. BuildImageTree;
  867. SelectSubImage(FImage.ActiveImage);
  868. finally
  869. Images.Free;
  870. end;
  871. end;
  872. end;
  873. procedure TMainForm.TreeImageSelectionChanged(Sender: TObject);
  874. var
  875. Node: TTreeNode;
  876. begin
  877. Node := TreeImage.Selected;
  878. if Node <> nil then
  879. SelectSubImage(PtrInt(Node.Data));
  880. end;
  881. procedure TMainForm.ActViewActualSizeExecute(Sender: TObject);
  882. begin
  883. ActViewActualSize.Checked := True;
  884. ActViewFitToWindow.Checked := False;
  885. Image.Proportional := False;
  886. Image.Stretch := False;
  887. end;
  888. procedure TMainForm.ActViewFitToWindowExecute(Sender: TObject);
  889. begin
  890. ActViewFitToWindow.Checked := True;
  891. ActViewActualSize.Checked := False;
  892. Image.Proportional := True;
  893. Image.Stretch := True;
  894. end;
  895. procedure TMainForm.ActViewInfoExecute(Sender: TObject);
  896. begin
  897. {$IFDEF MSWINDOWS}
  898. // For some strange reason ordinary MessageDlg sometimes shows empty message for
  899. // A8R8G8B8 images. Using Win32 msg box instead now.
  900. MessageBox(Handle, PChar(ImageToStr(FImage.ImageDataPointer^)), 'Image information', MB_OK or MB_ICONINFORMATION);
  901. {$ELSE}
  902. MessageDlg(ImageToStr(FImage.ImageDataPointer^), mtInformation, [mbOK], 0);
  903. {$ENDIF}
  904. end;
  905. procedure TMainForm.FormDestroy(Sender: TObject);
  906. begin
  907. FImageCanvas.Free;
  908. FBitmap.Free;
  909. FImage.Free;
  910. end;
  911. procedure TMainForm.FormDropFiles(Sender: TObject;
  912. const FileNames: array of String);
  913. begin
  914. if Length(FileNames) > 0 then
  915. OpenFile(FileNames[0]);
  916. end;
  917. procedure TMainForm.FormShow(Sender: TObject);
  918. begin
  919. if ClientWidth > 600 then
  920. PairSplitterSideLeft.Width := 280;
  921. WindowState := wsMaximized;
  922. end;
  923. procedure TMainForm.ImageClick(Sender: TObject);
  924. begin
  925. ActViewInfo.Execute;
  926. end;
  927. procedure TMainForm.MenuItem3Click(Sender: TObject);
  928. begin
  929. OpenDialog.Filter := GetImageFileFormatsFilter(True);
  930. if OpenDialog.Execute then
  931. OpenFile(OpenDialog.FileName);
  932. end;
  933. procedure TMainForm.MenuItem5Click(Sender: TObject);
  934. begin
  935. SaveDialog.Filter := GetImageFileFormatsFilter(False);
  936. SaveDialog.FileName := ChangeFileExt(ExtractFileName(FFileName), '');
  937. SaveDialog.FilterIndex := GetFileNameFilterIndex(FFileName, False);
  938. if SaveDialog.Execute then
  939. begin
  940. FFileName := ChangeFileExt(SaveDialog.FileName, '.' + GetFilterIndexExtension(SaveDialog.FilterIndex, False));
  941. SaveFile(FFileName);
  942. end;
  943. end;
  944. procedure TMainForm.MenuItem60Click(Sender: TObject);
  945. begin
  946. ApplyPointTransform(ptIncGamma);
  947. end;
  948. procedure TMainForm.MenuItem61Click(Sender: TObject);
  949. begin
  950. ApplyPointTransform(ptDecGamma);
  951. end;
  952. procedure TMainForm.MenuItem62Click(Sender: TObject);
  953. begin
  954. ApplyPointTransform(ptThreshold);
  955. end;
  956. procedure TMainForm.MenuItem64Click(Sender: TObject);
  957. begin
  958. ApplyNonLinear(nfMedian, 3);
  959. end;
  960. procedure TMainForm.MenuItem65Click(Sender: TObject);
  961. begin
  962. ApplyNonLinear(nfMedian, 5);
  963. end;
  964. procedure TMainForm.MenuItem66Click(Sender: TObject);
  965. begin
  966. ApplyNonLinear(nfMin, 3);
  967. end;
  968. procedure TMainForm.MenuItem67Click(Sender: TObject);
  969. begin
  970. ApplyNonLinear(nfMin, 5);
  971. end;
  972. procedure TMainForm.MenuItem68Click(Sender: TObject);
  973. begin
  974. ApplyNonLinear(nfMax, 3);
  975. end;
  976. procedure TMainForm.MenuItem69Click(Sender: TObject);
  977. begin
  978. ApplyNonLinear(nfMax, 5);
  979. end;
  980. procedure TMainForm.MenuItem70Click(Sender: TObject);
  981. begin
  982. ApplyAdditionalOp(aoOtsuThreshold);
  983. end;
  984. procedure TMainForm.MenuItem71Click(Sender: TObject);
  985. begin
  986. ApplyMorphology(mpErode);
  987. end;
  988. procedure TMainForm.MenuItem72Click(Sender: TObject);
  989. begin
  990. ApplyMorphology(mpDilate);
  991. end;
  992. procedure TMainForm.MenuItem73Click(Sender: TObject);
  993. begin
  994. ApplyMorphology(mpOpen);
  995. end;
  996. procedure TMainForm.MenuItem74Click(Sender: TObject);
  997. begin
  998. ApplyMorphology(mpClose);
  999. end;
  1000. procedure TMainForm.MenuItem75Click(Sender: TObject);
  1001. begin
  1002. ApplyPointTransform(ptLevelsLow);
  1003. end;
  1004. procedure TMainForm.MenuItem76Click(Sender: TObject);
  1005. begin
  1006. ApplyPointTransform(ptLevelsHigh);
  1007. end;
  1008. procedure TMainForm.MenuItem78Click(Sender: TObject);
  1009. begin
  1010. ApplyPointTransform(ptAlphaPreMult);
  1011. end;
  1012. procedure TMainForm.MenuItem79Click(Sender: TObject);
  1013. begin
  1014. ApplyPointTransform(ptAlphaUnPreMult);
  1015. end;
  1016. procedure TMainForm.MenuItem7Click(Sender: TObject);
  1017. begin
  1018. Close;
  1019. end;
  1020. procedure TMainForm.OpenFile(const FileName: string);
  1021. var
  1022. T: Int64;
  1023. begin
  1024. FFileName := FileName;
  1025. try
  1026. T := GetTimeMicroseconds;
  1027. GlobalMetadata.ClearMetaItems;
  1028. FImage.LoadMultiFromFile(FileName);
  1029. FFileSize := FileSize(FileName);
  1030. BuildImageTree;
  1031. GlobalMetadata.CopyLoadedMetaItemsForSaving;
  1032. MeasureTime(Format('File %s opened in:', [ExtractFileName(FileName)]), T);
  1033. except
  1034. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  1035. FImage.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  1036. TreeImage.Items.Clear;
  1037. end;
  1038. SelectSubImage(0);
  1039. end;
  1040. procedure TMainForm.BuildImageTree;
  1041. var
  1042. Root, Node: TTreeNode;
  1043. I: PtrInt;
  1044. Lab: string;
  1045. Data: TImageData;
  1046. begin
  1047. TreeImage.Items.Clear;
  1048. Lab := Format('%s (%d images)', [ExtractFileName(FFileName), FImage.ImageCount]);
  1049. Root := TreeImage.Items.Add(nil, Lab);
  1050. for I := 0 to FImage.ImageCount - 1 do
  1051. begin
  1052. Data := FImage.Images[I];
  1053. Lab := Format('Img%.2d %dx%d %s', [I, Data.Width, Data.Height, GetFormatName(Data.Format)]);
  1054. Node := TreeImage.Items.AddChild(Root, Lab);
  1055. Node.Data := Pointer(I);
  1056. end;
  1057. end;
  1058. procedure TMainForm.SaveFile(const FileName: string);
  1059. var
  1060. T: Int64;
  1061. begin
  1062. try
  1063. T := GetTimeMicroseconds;
  1064. FImage.SaveMultiToFile(FileName);
  1065. MeasureTime(Format('File %s saved in:', [ExtractFileName(FileName)]), T);
  1066. except
  1067. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  1068. end;
  1069. end;
  1070. procedure TMainForm.SelectSubImage(Index: LongInt);
  1071. begin
  1072. FImage.ActiveImage := Index;
  1073. MenuItemActSubImage.Caption := Format('Active Subimage: %d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]);
  1074. UpdateView(False);
  1075. end;
  1076. procedure TMainForm.UpdateView(RebuildTree: Boolean);
  1077. begin
  1078. Image.Picture.Graphic.Assign(FImage);
  1079. if RebuildTree then
  1080. BuildImageTree;
  1081. end;
  1082. procedure TMainForm.MeasureTime(const Msg: string; const OldTime: Int64);
  1083. begin
  1084. StatusBar.SimpleText := Format(' %s %.0n ms', [Msg, (GetTimeMicroseconds - OldTime) / 1000.0]);
  1085. end;
  1086. {
  1087. File Notes:
  1088. -- 0.80 Changes/Bug Fixes -----------------------------------
  1089. - Added "Add images from file" menu item
  1090. -- 0.77.1 Changes/Bug Fixes ---------------------------------
  1091. - Writing metadata from loaded file when resaving.
  1092. - Added Otsu Thresholding and Deskwing, reorganized some menus.
  1093. - Added Lanczos filtering option to resize image functions.
  1094. - Added option to convert data format of all subimages by default.
  1095. - UI enhancements: added TreeView with image/subimage list,
  1096. added StatusBar instead of simple Panel.
  1097. -- 0.26.5 Changes/Bug Fixes ---------------------------------
  1098. - You can drop file on the form to open it.
  1099. - Added "Show Metadata" item to View menu + related functionality.
  1100. -- 0.26.3 Changes/Bug Fixes ---------------------------------
  1101. - Added Free Resize and Free Rotate functions to Manipulate menu.
  1102. - Added premult/unpremult alpha point transforms.
  1103. -- 0.26.1 Changes/Bug Fixes ---------------------------------
  1104. - Added "show histogram" menu item and functionality.
  1105. - Added new Colors submenu with "set channel set value" commands.
  1106. - Added Canvas.AdjustColorLevels example.
  1107. -- 0.25.0 Changes/Bug Fixes ---------------------------------
  1108. - Added binary morphology operations.
  1109. - Added point transforms and non-linear filters.
  1110. -- 0.24.1 Changes/Bug Fixes ---------------------------------
  1111. - Added status bar which shows times taken by some oprations.
  1112. - Reworked manipulation commands to get rid of UpdateView calls
  1113. everywhere.
  1114. - With Lazarus 0.9.24 images are now displayed with
  1115. proper transparency (those with alpha). Also it doesn't
  1116. screw up some images with 'Fit to window' so that is now
  1117. default.
  1118. -- 0.23 Changes/Bug Fixes -----------------------------------
  1119. - Catches exceptions during file load/save.
  1120. -- 0.21 Changes/Bug Fixes -----------------------------------
  1121. - Save As... now saves all images levels instead of just current one.
  1122. - Added XP controls manifest to resource file.
  1123. - Added new filters to Effects menu.
  1124. -- 0.19 Changes/Bug Fixes -----------------------------------
  1125. - you can now open image in Imager from shell by passing
  1126. path to image as parameter: 'LCLImager /home/myimage.jpg'
  1127. - added Reload from File menu to reload image from disk
  1128. (poor man's Undo)
  1129. - added Effects menu with some convolution filters
  1130. - added support for displaying of multi images
  1131. -- 0.17 Changes/Bug Fixes -----------------------------------
  1132. - added Nearest, Bilinear, and Bicubic filter options to
  1133. Resize To 50/200% menu items
  1134. - better handling of file exts when using save dialog
  1135. - added rotations to Manipulate menu
  1136. - now works well in Linux too
  1137. -- 0.15 Changes/Bug Fixes -----------------------------------
  1138. - created
  1139. }
  1140. end.