mainunit.pas 31 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084
  1. {
  2. Vampyre Imaging Library Demo
  3. LCL Imager (ObjectPascal, high level/component sets/canvas, Win32/Linux/BSD)
  4. tested in Lazarus 0.9.26 (Windows: Win32, Qt, Gtk2; Unix: Gtk)
  5. written by Marek Mauder
  6. Simple image manipulator program which shows usage of Imaging VCL/CLX/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,
  28. Menus, ExtCtrls, ExtDlgs, DemoUtils, AboutUnit, ActnList,
  29. ImagingTypes,
  30. Imaging,
  31. ImagingClasses,
  32. ImagingComponents,
  33. ImagingCanvases,
  34. ImagingBinary,
  35. ImagingUtility;
  36. type
  37. TManipulationType = (mtFlip, mtMirror, mtRotate90CW, mtRotate90CCW,
  38. mtFreeRotate, mtResize50, mtResize200, mtFreeResize,
  39. mtSwapRB, mtSwapRG, mtSwapGB, mtReduce1024,
  40. mtReduce256, mtReduce64, mtReduce16, mtReduce2);
  41. TPointTransform = (ptInvert, ptIncContrast, ptDecContrast, ptIncBrightness,
  42. ptDecBrightness, ptIncGamma, ptDecGamma, ptThreshold, ptLevelsLow,
  43. ptLevelsHigh, ptAlphaPreMult, ptAlphaUnPreMult);
  44. TNonLinearFilter = (nfMedian, nfMin, nfMax);
  45. TMorphology = (mpErode, mpDilate, mpOpen, mpClose);
  46. { TMainForm }
  47. TMainForm = class(TForm)
  48. ActViewInfo: TAction;
  49. ActViewFitToWindow: TAction;
  50. ActViewRealSize: TAction;
  51. ActionList1: TActionList;
  52. Image: TImage;
  53. MainMenu: TMainMenu;
  54. MenuItem1: TMenuItem;
  55. MenuItem10: TMenuItem;
  56. MenuItem11: TMenuItem;
  57. MenuItem12: TMenuItem;
  58. MenuItem13: TMenuItem;
  59. MenuItem14: TMenuItem;
  60. MenuItem15: TMenuItem;
  61. MenuItem16: TMenuItem;
  62. MenuItem17: TMenuItem;
  63. FormatItem: TMenuItem;
  64. MenuItem18: TMenuItem;
  65. MenuItem19: TMenuItem;
  66. MenuItem2: TMenuItem;
  67. MenuItem20: TMenuItem;
  68. MenuItem21: TMenuItem;
  69. MenuItem22: TMenuItem;
  70. MenuItem23: TMenuItem;
  71. MenuItem24: TMenuItem;
  72. MenuItem25: TMenuItem;
  73. MenuItem26: TMenuItem;
  74. MenuItem27: TMenuItem;
  75. MenuItem28: TMenuItem;
  76. MenuItem29: TMenuItem;
  77. MenuItem3: TMenuItem;
  78. MenuItem30: TMenuItem;
  79. MenuItem31: TMenuItem;
  80. MenuItem32: TMenuItem;
  81. MenuItem33: TMenuItem;
  82. MenuItem36: TMenuItem;
  83. MenuItem37: TMenuItem;
  84. MenuItem38: TMenuItem;
  85. MenuItem39: TMenuItem;
  86. MenuItem40: TMenuItem;
  87. MenuItem41: TMenuItem;
  88. MenuItem42: TMenuItem;
  89. MenuItem43: TMenuItem;
  90. MenuItem44: TMenuItem;
  91. MenuItem45: TMenuItem;
  92. MenuItem46: TMenuItem;
  93. MenuItem47: TMenuItem;
  94. MenuItem48: TMenuItem;
  95. MenuItem49: TMenuItem;
  96. MenuItem50: TMenuItem;
  97. MenuItem51: TMenuItem;
  98. MenuItem52: TMenuItem;
  99. MenuItem53: TMenuItem;
  100. MenuItem54: TMenuItem;
  101. MenuItem55: TMenuItem;
  102. MenuItem56: TMenuItem;
  103. MenuItem57: TMenuItem;
  104. MenuItem58: TMenuItem;
  105. MenuItem59: TMenuItem;
  106. MenuItem60: TMenuItem;
  107. MenuItem61: TMenuItem;
  108. MenuItem62: TMenuItem;
  109. MenuItem63: TMenuItem;
  110. MenuItem64: TMenuItem;
  111. MenuItem65: TMenuItem;
  112. MenuItem66: TMenuItem;
  113. MenuItem67: TMenuItem;
  114. MenuItem68: TMenuItem;
  115. MenuItem69: TMenuItem;
  116. MenuItem70: TMenuItem;
  117. MenuItem71: TMenuItem;
  118. MenuItem72: TMenuItem;
  119. MenuItem73: TMenuItem;
  120. MenuItem74: TMenuItem;
  121. MenuItem75: TMenuItem;
  122. MenuItem76: TMenuItem;
  123. MenuItem77: TMenuItem;
  124. AlphaItem: TMenuItem;
  125. MenuItem78: TMenuItem;
  126. MenuItem79: TMenuItem;
  127. MenuItem80: TMenuItem;
  128. MenuItem81: TMenuItem;
  129. MenuItem83: TMenuItem;
  130. MenuItem84: TMenuItem;
  131. MenuItem85: TMenuItem;
  132. RedItem: TMenuItem;
  133. GreenItem: TMenuItem;
  134. BlueItem: TMenuItem;
  135. MenuItem82: TMenuItem;
  136. MenuItemActSubImage: TMenuItem;
  137. MenuItem34: TMenuItem;
  138. MenuItem35: TMenuItem;
  139. MenuItem4: TMenuItem;
  140. MenuItem5: TMenuItem;
  141. MenuItem6: TMenuItem;
  142. MenuItem7: TMenuItem;
  143. MenuItem8: TMenuItem;
  144. MenuItem9: TMenuItem;
  145. OpenD: TOpenPictureDialog;
  146. PanelStatus: TPanel;
  147. SaveD: TSavePictureDialog;
  148. procedure ActViewFitToWindowExecute(Sender: TObject);
  149. procedure ActViewInfoExecute(Sender: TObject);
  150. procedure ActViewRealSizeExecute(Sender: TObject);
  151. procedure FormCreate(Sender: TObject);
  152. procedure FormDestroy(Sender: TObject);
  153. procedure ImageClick(Sender: TObject);
  154. procedure MenuItem10Click(Sender: TObject);
  155. procedure MenuItem12Click(Sender: TObject);
  156. procedure MenuItem13Click(Sender: TObject);
  157. procedure MenuItem14Click(Sender: TObject);
  158. procedure MenuItem15Click(Sender: TObject);
  159. procedure MenuItem18Click(Sender: TObject);
  160. procedure MenuItem19Click(Sender: TObject);
  161. procedure MenuItem20Click(Sender: TObject);
  162. procedure MenuItem23Click(Sender: TObject);
  163. procedure MenuItem24Click(Sender: TObject);
  164. procedure MenuItem26Click(Sender: TObject);
  165. procedure MenuItem27Click(Sender: TObject);
  166. procedure MenuItem28Click(Sender: TObject);
  167. procedure MenuItem29Click(Sender: TObject);
  168. procedure MenuItem2Click(Sender: TObject);
  169. procedure MenuItem30Click(Sender: TObject);
  170. procedure MenuItem31Click(Sender: TObject);
  171. procedure MenuItem33Click(Sender: TObject);
  172. procedure MenuItem34Click(Sender: TObject);
  173. procedure MenuItem35Click(Sender: TObject);
  174. procedure MenuItem37Click(Sender: TObject);
  175. procedure MenuItem38Click(Sender: TObject);
  176. procedure MenuItem39Click(Sender: TObject);
  177. procedure MenuItem3Click(Sender: TObject);
  178. procedure MenuItem40Click(Sender: TObject);
  179. procedure MenuItem41Click(Sender: TObject);
  180. procedure MenuItem42Click(Sender: TObject);
  181. procedure MenuItem43Click(Sender: TObject);
  182. procedure MenuItem44Click(Sender: TObject);
  183. procedure MenuItem45Click(Sender: TObject);
  184. procedure MenuItem46Click(Sender: TObject);
  185. procedure MenuItem47Click(Sender: TObject);
  186. procedure MenuItem48Click(Sender: TObject);
  187. procedure MenuItem4Click(Sender: TObject);
  188. procedure MenuItem50Click(Sender: TObject);
  189. procedure MenuItem51Click(Sender: TObject);
  190. procedure MenuItem53Click(Sender: TObject);
  191. procedure MenuItem54Click(Sender: TObject);
  192. procedure MenuItem56Click(Sender: TObject);
  193. procedure MenuItem57Click(Sender: TObject);
  194. procedure MenuItem58Click(Sender: TObject);
  195. procedure MenuItem59Click(Sender: TObject);
  196. procedure MenuItem5Click(Sender: TObject);
  197. procedure MenuItem60Click(Sender: TObject);
  198. procedure MenuItem61Click(Sender: TObject);
  199. procedure MenuItem62Click(Sender: TObject);
  200. procedure MenuItem64Click(Sender: TObject);
  201. procedure MenuItem65Click(Sender: TObject);
  202. procedure MenuItem66Click(Sender: TObject);
  203. procedure MenuItem67Click(Sender: TObject);
  204. procedure MenuItem68Click(Sender: TObject);
  205. procedure MenuItem69Click(Sender: TObject);
  206. procedure MenuItem71Click(Sender: TObject);
  207. procedure MenuItem72Click(Sender: TObject);
  208. procedure MenuItem73Click(Sender: TObject);
  209. procedure MenuItem74Click(Sender: TObject);
  210. procedure MenuItem75Click(Sender: TObject);
  211. procedure MenuItem76Click(Sender: TObject);
  212. procedure MenuItem78Click(Sender: TObject);
  213. procedure MenuItem79Click(Sender: TObject);
  214. procedure MenuItem7Click(Sender: TObject);
  215. procedure FormatChangeClick(Sender: TObject);
  216. procedure ChannelSetClick(Sender: TObject);
  217. procedure MenuItem80Click(Sender: TObject);
  218. procedure MenuItem82Click(Sender: TObject);
  219. procedure MenuItem83Click(Sender: TObject);
  220. procedure MenuItem84Click(Sender: TObject);
  221. procedure MenuItem85Click(Sender: TObject);
  222. private
  223. FBitmap: TImagingBitmap;
  224. FImage: TMultiImage;
  225. FImageCanvas: TImagingCanvas;
  226. FFileName: string;
  227. FParam1, FParam2, FParam3: Integer;
  228. procedure OpenFile(const FileName: string);
  229. procedure SaveFile(const FileName: string);
  230. procedure SelectSubimage(Index: LongInt);
  231. procedure UpdateView;
  232. function CheckCanvasFormat: Boolean;
  233. procedure ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  234. procedure ApplyPointTransform(Transform: TPointTransform);
  235. procedure ApplyManipulation(ManipType: TManipulationType);
  236. procedure ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  237. procedure ApplyMorphology(MorphOp: TMorphology);
  238. procedure MeasureTime(const Msg: string; const OldTime: Int64);
  239. procedure FreeResizeInput;
  240. function InputInteger(const ACaption, APrompt: string; var Value: Integer): Boolean;
  241. public
  242. end;
  243. const
  244. SWindowTitle = 'LCL Imager - Vampyre Imaging Library %s Demo';
  245. var
  246. MainForm: TMainForm;
  247. implementation
  248. {$IFDEF MSWINDOWS}
  249. uses
  250. Windows;
  251. {$ENDIF}
  252. { TMainForm }
  253. procedure TMainForm.MenuItem10Click(Sender: TObject);
  254. begin
  255. AboutForm.ShowModal;
  256. end;
  257. procedure TMainForm.MenuItem12Click(Sender: TObject);
  258. begin
  259. ApplyManipulation(mtSwapRB);
  260. end;
  261. procedure TMainForm.MenuItem13Click(Sender: TObject);
  262. begin
  263. ApplyManipulation(mtSwapRG);
  264. end;
  265. procedure TMainForm.MenuItem14Click(Sender: TObject);
  266. begin
  267. ApplyManipulation(mtSwapGB);
  268. end;
  269. procedure TMainForm.MenuItem15Click(Sender: TObject);
  270. begin
  271. ApplyManipulation(mtReduce1024);
  272. end;
  273. procedure TMainForm.MenuItem18Click(Sender: TObject);
  274. begin
  275. ApplyManipulation(mtReduce256);
  276. end;
  277. procedure TMainForm.MenuItem19Click(Sender: TObject);
  278. begin
  279. ApplyManipulation(mtReduce64);
  280. end;
  281. procedure TMainForm.MenuItem20Click(Sender: TObject);
  282. begin
  283. ApplyManipulation(mtReduce16);
  284. end;
  285. procedure TMainForm.MenuItem4Click(Sender: TObject);
  286. begin
  287. ApplyManipulation(mtMirror);
  288. end;
  289. procedure TMainForm.MenuItem23Click(Sender: TObject);
  290. begin
  291. ApplyManipulation(mtRotate90CW);
  292. end;
  293. procedure TMainForm.MenuItem24Click(Sender: TObject);
  294. begin
  295. ApplyManipulation(mtRotate90CCW);
  296. end;
  297. procedure TMainForm.MenuItem26Click(Sender: TObject);
  298. begin
  299. FParam1 := Ord(rfNearest);
  300. ApplyManipulation(mtResize50);
  301. end;
  302. procedure TMainForm.MenuItem27Click(Sender: TObject);
  303. begin
  304. FParam1 := Ord(rfBilinear);
  305. ApplyManipulation(mtResize50);
  306. end;
  307. procedure TMainForm.MenuItem28Click(Sender: TObject);
  308. begin
  309. FParam1 := Ord(rfBicubic);
  310. ApplyManipulation(mtResize50);
  311. end;
  312. procedure TMainForm.MenuItem29Click(Sender: TObject);
  313. begin
  314. FParam1 := Ord(rfNearest);
  315. ApplyManipulation(mtResize200);
  316. end;
  317. procedure TMainForm.MenuItem30Click(Sender: TObject);
  318. begin
  319. FParam1 := Ord(rfBilinear);
  320. ApplyManipulation(mtResize200);
  321. end;
  322. procedure TMainForm.MenuItem31Click(Sender: TObject);
  323. begin
  324. FParam1 := Ord(rfBicubic);
  325. ApplyManipulation(mtResize200);
  326. end;
  327. procedure TMainForm.MenuItem2Click(Sender: TObject);
  328. begin
  329. ApplyManipulation(mtFlip);
  330. end;
  331. procedure TMainForm.MenuItem33Click(Sender: TObject);
  332. begin
  333. ApplyManipulation(mtReduce2);
  334. end;
  335. procedure TMainForm.MenuItem37Click(Sender: TObject);
  336. begin
  337. ApplyConvolution(@FilterGaussian3x3, 3, False);
  338. end;
  339. procedure TMainForm.MenuItem38Click(Sender: TObject);
  340. begin
  341. ApplyConvolution(@FilterGaussian5x5, 5, False);
  342. end;
  343. procedure TMainForm.MenuItem39Click(Sender: TObject);
  344. begin
  345. ApplyConvolution(@FilterSharpen3x3, 3, False);
  346. end;
  347. procedure TMainForm.MenuItem40Click(Sender: TObject);
  348. begin
  349. ApplyConvolution(@FilterSharpen5x5, 5, False);
  350. end;
  351. procedure TMainForm.MenuItem41Click(Sender: TObject);
  352. begin
  353. ApplyConvolution(@FilterLaplace5x5, 5, True);
  354. end;
  355. procedure TMainForm.MenuItem42Click(Sender: TObject);
  356. begin
  357. ApplyConvolution(@FilterSobelHorz3x3, 3, True);
  358. end;
  359. procedure TMainForm.MenuItem43Click(Sender: TObject);
  360. begin
  361. ApplyConvolution(@FilterSobelVert3x3, 3, True);
  362. end;
  363. procedure TMainForm.MenuItem44Click(Sender: TObject);
  364. begin
  365. OpenFile(FFileName);
  366. end;
  367. procedure TMainForm.MenuItem45Click(Sender: TObject);
  368. begin
  369. ApplyConvolution(@FilterGlow5x5, 5, False);
  370. end;
  371. procedure TMainForm.MenuItem46Click(Sender: TObject);
  372. begin
  373. ApplyConvolution(@FilterEmboss3x3, 3, True);
  374. end;
  375. procedure TMainForm.MenuItem47Click(Sender: TObject);
  376. begin
  377. ApplyPointTransform(ptIncContrast);
  378. end;
  379. procedure TMainForm.MenuItem48Click(Sender: TObject);
  380. begin
  381. ApplyConvolution(@FilterEdgeEnhance3x3, 3, False);
  382. end;
  383. procedure TMainForm.MenuItem50Click(Sender: TObject);
  384. begin
  385. ApplyConvolution(@FilterPrewittHorz3x3, 3, True);
  386. end;
  387. procedure TMainForm.MenuItem51Click(Sender: TObject);
  388. begin
  389. ApplyConvolution(@FilterKirshHorz3x3, 3, True);
  390. end;
  391. procedure TMainForm.MenuItem53Click(Sender: TObject);
  392. begin
  393. ApplyConvolution(@FilterPrewittVert3x3, 3, True);
  394. end;
  395. procedure TMainForm.MenuItem54Click(Sender: TObject);
  396. begin
  397. ApplyConvolution(@FilterKirshVert3x3, 3, True);
  398. end;
  399. procedure TMainForm.MenuItem56Click(Sender: TObject);
  400. begin
  401. ApplyPointTransform(ptInvert);
  402. end;
  403. procedure TMainForm.MenuItem57Click(Sender: TObject);
  404. begin
  405. ApplyPointTransform(ptDecContrast);
  406. end;
  407. procedure TMainForm.MenuItem58Click(Sender: TObject);
  408. begin
  409. ApplyPointTransform(ptIncBrightness);
  410. end;
  411. procedure TMainForm.MenuItem59Click(Sender: TObject);
  412. begin
  413. ApplyPointTransform(ptDecBrightness);
  414. end;
  415. procedure TMainForm.MenuItem34Click(Sender: TObject);
  416. begin
  417. SelectSubimage(FImage.ActiveImage + 1);
  418. end;
  419. procedure TMainForm.MenuItem35Click(Sender: TObject);
  420. begin
  421. SelectSubimage(FImage.ActiveImage - 1);
  422. end;
  423. function TMainForm.CheckCanvasFormat: Boolean;
  424. begin
  425. Result := FImage.Format in FImageCanvas.GetSupportedFormats;
  426. if not Result then
  427. MessageDlg('Image is in format that is not supported by TImagingCanvas.', mtError, [mbOK], 0);
  428. end;
  429. procedure TMainForm.ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  430. var
  431. T: Int64;
  432. begin
  433. if CheckCanvasFormat then
  434. begin
  435. FImageCanvas.CreateForImage(FImage);
  436. T := GetTimeMicroseconds;
  437. if NeedsBlur then
  438. FImageCanvas.ApplyConvolution3x3(FilterGaussian3x3);
  439. if Size = 3 then
  440. FImageCanvas.ApplyConvolution3x3(TConvolutionFilter3x3(Kernel^))
  441. else
  442. FImageCanvas.ApplyConvolution5x5(TConvolutionFilter5x5(Kernel^));
  443. MeasureTime('Image convolved in:', T);
  444. UpdateView;
  445. end;
  446. end;
  447. procedure TMainForm.ApplyPointTransform(Transform: TPointTransform);
  448. var
  449. T: Int64;
  450. begin
  451. if CheckCanvasFormat then
  452. begin
  453. FImageCanvas.CreateForImage(FImage);
  454. T := GetTimeMicroseconds;
  455. case Transform of
  456. ptInvert: FImageCanvas.InvertColors;
  457. ptIncContrast: FImageCanvas.ModifyContrastBrightness(20, 0);
  458. ptDecContrast: FImageCanvas.ModifyContrastBrightness(-20, 0);
  459. ptIncBrightness: FImageCanvas.ModifyContrastBrightness(0, 20);
  460. ptDecBrightness: FImageCanvas.ModifyContrastBrightness(0, -20);
  461. ptIncGamma: FImageCanvas.GammaCorection(1.2, 1.2, 1.2);
  462. ptDecGamma: FImageCanvas.GammaCorection(0.8, 0.8, 0.8);
  463. ptThreshold: FImageCanvas.Threshold(0.5, 0.5, 0.5);
  464. ptLevelsLow: FImageCanvas.AdjustColorLevels(0.0, 0.5, 1.0);
  465. ptLevelsHigh: FImageCanvas.AdjustColorLevels(0.35, 1.0, 0.9);
  466. ptAlphaPreMult: FImageCanvas.PremultiplyAlpha;
  467. ptAlphaUnPreMult: FImageCanvas.UnPremultiplyAlpha;
  468. end;
  469. MeasureTime('Point transform done in:', T);
  470. UpdateView;
  471. end;
  472. end;
  473. procedure TMainForm.ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  474. var
  475. T: Int64;
  476. begin
  477. if CheckCanvasFormat then
  478. begin
  479. FImageCanvas.CreateForImage(FImage);
  480. T := GetTimeMicroseconds;
  481. case FilterType of
  482. nfMedian: FImageCanvas.ApplyMedianFilter(FilterSize);
  483. nfMin: FImageCanvas.ApplyMinFilter(FilterSize);
  484. nfMax: FImageCanvas.ApplyMaxFilter(FilterSize);
  485. end;
  486. MeasureTime('Point transform done in:', T);
  487. UpdateView;
  488. end;
  489. end;
  490. procedure TMainForm.ApplyMorphology(MorphOp: TMorphology);
  491. var
  492. T: Int64;
  493. Strel: TStructElement;
  494. begin
  495. T := GetTimeMicroseconds;
  496. OtsuThresholding(FImage.ImageDataPointer^);
  497. SetLength(Strel, 3, 3);
  498. Strel[0, 0] := 0;
  499. Strel[1, 0] := 1;
  500. Strel[2, 0] := 0;
  501. Strel[0, 1] := 1;
  502. Strel[1, 1] := 1;
  503. Strel[2, 1] := 1;
  504. Strel[0, 2] := 0;
  505. Strel[1, 2] := 1;
  506. Strel[2, 2] := 0;
  507. case MorphOp of
  508. mpErode: Morphology(FImage.ImageDataPointer^, Strel, moErode);
  509. mpDilate: Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  510. mpOpen:
  511. begin
  512. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  513. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  514. end;
  515. mpClose:
  516. begin
  517. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  518. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  519. end;
  520. end;
  521. MeasureTime('Morphology operation applied in:', T);
  522. UpdateView;
  523. end;
  524. procedure TMainForm.ApplyManipulation(ManipType: TManipulationType);
  525. var
  526. T: Int64;
  527. begin
  528. T := GetTimeMicroseconds;
  529. case ManipType of
  530. mtFlip: FImage.Flip;
  531. mtMirror: FImage.Mirror;
  532. mtRotate90CW: FImage.Rotate(-90);
  533. mtRotate90CCW: FImage.Rotate(90);
  534. mtFreeRotate: FImage.Rotate(FParam1);
  535. mtResize50: FImage.Resize(FImage.Width div 2, FImage.Height div 2, TResizeFilter(FParam1));
  536. mtResize200: FImage.Resize(FImage.Width * 2, FImage.Height * 2, TResizeFilter(FParam1));
  537. mtFreeResize: FImage.Resize(FParam2, FParam3, TResizeFilter(FParam1));
  538. mtSwapRB: FImage.SwapChannels(ChannelRed, ChannelBlue);
  539. mtSwapRG: FImage.SwapChannels(ChannelRed, ChannelGreen);
  540. mtSwapGB: FImage.SwapChannels(ChannelGreen, ChannelBlue);
  541. mtReduce1024: ReduceColors(FImage.ImageDataPointer^, 1024);
  542. mtReduce256: ReduceColors(FImage.ImageDataPointer^, 256);
  543. mtReduce64: ReduceColors(FImage.ImageDataPointer^, 64);
  544. mtReduce16: ReduceColors(FImage.ImageDataPointer^, 16);
  545. mtReduce2: ReduceColors(FImage.ImageDataPointer^, 2);
  546. end;
  547. MeasureTime('Image manipulated in:', T);
  548. UpdateView;
  549. end;
  550. procedure TMainForm.FormCreate(Sender: TObject);
  551. var
  552. Item: TMenuItem;
  553. Fmt: TImageFormat;
  554. Info: TImageFormatInfo;
  555. function Clone(AItem: TMenuItem): TMenuItem;
  556. begin
  557. Result := TMenuItem.Create(MainMenu);
  558. Result.Caption := AItem.Caption;
  559. Result.Tag := AItem.Tag;
  560. Result.OnClick := AItem.OnClick;;
  561. end;
  562. procedure AddSetChannelItem(const Caption: string; Value: Integer);
  563. begin
  564. Item := TMenuItem.Create(MainMenu);
  565. Item.Caption := Caption;
  566. Item.Tag := Value;
  567. Item.OnClick := ChannelSetClick;
  568. AlphaItem.Add(Item);
  569. RedItem.Add(Clone(Item));
  570. GreenItem.Add(Clone(Item));
  571. BlueItem.Add(Clone(Item));
  572. end;
  573. begin
  574. Caption := Format(SWindowTitle, [Imaging.GetVersionStr]);
  575. { Source image and Image's graphic are created and
  576. default image is opened.}
  577. FImage := TMultiImage.Create;
  578. FBitmap := TImagingBitmap.Create;
  579. Image.Picture.Graphic := FBitmap;
  580. FImageCanvas := TImagingCanvas.Create;
  581. { This builds Format submenu containing all possible
  582. image data formats (it dos not start at Low(TImageFormat)
  583. because there are some helper formats). Format for each item
  584. is stored in its Tag for later use in OnClick event.}
  585. for Fmt := ifIndex8 to High(TImageFormat) do
  586. begin
  587. GetImageFormatInfo(Fmt, Info);
  588. if Info.Name <> '' then
  589. begin
  590. Item := TMenuItem.Create(MainMenu);
  591. Item.Caption := Info.Name;
  592. Item.Tag := Ord(Fmt);
  593. Item.OnClick := FormatChangeClick;
  594. FormatItem.Add(Item);
  595. end;
  596. end;
  597. AddSetChannelItem('Set to 5%', 12);
  598. AddSetChannelItem('Set to 50%', 128);
  599. AddSetChannelItem('Set to 100%', 255);
  600. // Set 'Fit to window' mode
  601. ActViewFitToWindowExecute(Self);
  602. if (ParamCount > 0) and FileExists(ParamStr(1)) then
  603. OpenFile(ParamStr(1))
  604. else
  605. OpenFile(GetDataDir + PathDelim + 'Tigers.jpg')
  606. end;
  607. procedure TMainForm.FormatChangeClick(Sender: TObject);
  608. var
  609. T: Int64;
  610. begin
  611. with Sender as TMenuItem do
  612. begin
  613. T := GetTimeMicroseconds;
  614. FImage.Format := TImageFormat(Tag);
  615. MeasureTime('Image converted in:', T);
  616. UpdateView;
  617. end;
  618. end;
  619. procedure TMainForm.ChannelSetClick(Sender: TObject);
  620. var
  621. T: Int64;
  622. Canvas: TImagingCanvas;
  623. ChanId: Integer;
  624. begin
  625. if CheckCanvasFormat then
  626. with Sender as TMenuItem do
  627. begin
  628. case Parent.Caption[1] of
  629. 'A': ChanId := ChannelAlpha;
  630. 'R': ChanId := ChannelRed;
  631. 'G': ChanId := ChannelGreen;
  632. 'B': ChanId := ChannelBlue;
  633. else
  634. ChanId := ChannelRed;
  635. end;
  636. Canvas := TImagingCanvas.CreateForImage(FImage);
  637. T := GetTimeMicroseconds;
  638. Canvas.FillChannel(ChanId, Tag);
  639. MeasureTime('Channel filled in:', T);
  640. Canvas.Free;
  641. UpdateView;
  642. end;
  643. end;
  644. procedure TMainForm.MenuItem80Click(Sender: TObject);
  645. begin
  646. if InputInteger('Free Rotate', 'Enter angle in degrees:', FParam1) then
  647. ApplyManipulation(mtFreeRotate);
  648. end;
  649. procedure TMainForm.FreeResizeInput;
  650. begin
  651. if InputInteger('Free Resize', 'Enter width in pixels', FParam2) and
  652. InputInteger('Free Resize', 'Enter height in pixels', FParam3) then
  653. begin
  654. ApplyManipulation(mtFreeResize);
  655. end;
  656. end;
  657. function TMainForm.InputInteger(const ACaption, APrompt: string;
  658. var Value: Integer): Boolean;
  659. var
  660. StrVal: string;
  661. begin
  662. Result := False;
  663. if Dialogs.InputQuery(ACaption, APrompt, StrVal) then
  664. begin
  665. if TryStrToInt(StrVal, Value) then
  666. Exit(True)
  667. else
  668. MessageDlg('Cannot convert input to number', mtError, [mbOK], 0);
  669. end;
  670. end;
  671. procedure TMainForm.MenuItem82Click(Sender: TObject);
  672. var
  673. T: Int64;
  674. Canvas: TImagingCanvas;
  675. Red, Green, Blue, Alpha, Gray: THistogramArray;
  676. I, MaxPixels: Integer;
  677. Factor: Single;
  678. procedure VisualizeHistogram(const Histo: THistogramArray; Color: TColor32; Offset: Integer);
  679. var
  680. I: Integer;
  681. begin
  682. Canvas.PenColor32 := Color;
  683. for I := 0 to 255 do
  684. Canvas.VertLine(I + Offset, 256 - Round(Histo[I] * Factor), 255);
  685. end;
  686. begin
  687. if CheckCanvasFormat then
  688. begin
  689. Canvas := TImagingCanvas.CreateForImage(FImage);
  690. T := GetTimeMicroseconds;
  691. Canvas.GetHistogram(Red, Green, Blue, Alpha, Gray);
  692. MeasureTime('Histograms computed in:', T);
  693. FImage.RecreateImageData(1024, 256, ifA8R8G8B8);
  694. Canvas.UpdateCanvasState;
  695. Canvas.FillColor32 := pcBlack;
  696. Canvas.FillRect(FImage.BoundsRect);
  697. MaxPixels := 0;
  698. for I := 0 to 255 do
  699. if Red[I] > MaxPixels then MaxPixels := Red[I];
  700. for I := 0 to 255 do
  701. if Green[I] > MaxPixels then MaxPixels := Green[I];
  702. for I := 0 to 255 do
  703. if Blue[I] > MaxPixels then MaxPixels := Blue[I];
  704. for I := 0 to 255 do
  705. if Gray[I] > MaxPixels then MaxPixels := Gray[I];
  706. Factor := 256 / MaxPixels;
  707. VisualizeHistogram(Red, pcRed, 0);
  708. VisualizeHistogram(Green, pcGreen, 256);
  709. VisualizeHistogram(Blue, pcBlue, 512);
  710. VisualizeHistogram(Gray, pcGray, 768);
  711. Canvas.Free;
  712. UpdateView;
  713. end;
  714. end;
  715. procedure TMainForm.MenuItem83Click(Sender: TObject);
  716. begin
  717. FParam1 := Ord(rfNearest);
  718. FreeResizeInput;
  719. end;
  720. procedure TMainForm.MenuItem84Click(Sender: TObject);
  721. begin
  722. FParam1 := Ord(rfBilinear);
  723. FreeResizeInput;
  724. end;
  725. procedure TMainForm.MenuItem85Click(Sender: TObject);
  726. begin
  727. FParam1 := Ord(rfBicubic);
  728. FreeResizeInput;
  729. end;
  730. procedure TMainForm.ActViewRealSizeExecute(Sender: TObject);
  731. begin
  732. ActViewRealSize.Checked := True;
  733. ActViewFitToWindow.Checked := False;
  734. Image.Proportional := False;
  735. Image.Stretch := False;
  736. end;
  737. procedure TMainForm.ActViewFitToWindowExecute(Sender: TObject);
  738. begin
  739. ActViewFitToWindow.Checked := True;
  740. ActViewRealSize.Checked := False;
  741. Image.Proportional := True;
  742. Image.Stretch := True;
  743. end;
  744. procedure TMainForm.ActViewInfoExecute(Sender: TObject);
  745. begin
  746. {$IFDEF MSWINDOWS}
  747. // For some strange reason ordinary MessageDlg sometimes shows empty message for
  748. // A8R8G8B8 images. Using Win32 msg box instead now.
  749. MessageBox(Handle, PChar(ImageToStr(FImage.ImageDataPointer^)), 'Image information', MB_OK or MB_ICONINFORMATION);
  750. {$ELSE}
  751. MessageDlg(ImageToStr(FImage.ImageDataPointer^), mtInformation, [mbOK], 0);
  752. {$ENDIF}
  753. end;
  754. procedure TMainForm.FormDestroy(Sender: TObject);
  755. begin
  756. FImageCanvas.Free;
  757. FBitmap.Free;
  758. FImage.Free;
  759. end;
  760. procedure TMainForm.ImageClick(Sender: TObject);
  761. begin
  762. ActViewInfo.Execute;
  763. end;
  764. procedure TMainForm.MenuItem3Click(Sender: TObject);
  765. begin
  766. OpenD.Filter := GetImageFileFormatsFilter(True);
  767. if OpenD.Execute then
  768. OpenFile(OpenD.FileName);
  769. end;
  770. procedure TMainForm.MenuItem5Click(Sender: TObject);
  771. begin
  772. SaveD.Filter := GetImageFileFormatsFilter(False);
  773. SaveD.FileName := ChangeFileExt(ExtractFileName(FFileName), '');
  774. SaveD.FilterIndex := GetFileNameFilterIndex(FFileName, False);
  775. if SaveD.Execute then
  776. begin
  777. FFileName := ChangeFileExt(SaveD.FileName, '.' + GetFilterIndexExtension(SaveD.FilterIndex, False));
  778. SaveFile(FFileName);
  779. end;
  780. end;
  781. procedure TMainForm.MenuItem60Click(Sender: TObject);
  782. begin
  783. ApplyPointTransform(ptIncGamma);
  784. end;
  785. procedure TMainForm.MenuItem61Click(Sender: TObject);
  786. begin
  787. ApplyPointTransform(ptDecGamma);
  788. end;
  789. procedure TMainForm.MenuItem62Click(Sender: TObject);
  790. begin
  791. ApplyPointTransform(ptThreshold);
  792. end;
  793. procedure TMainForm.MenuItem64Click(Sender: TObject);
  794. begin
  795. ApplyNonLinear(nfMedian, 3);
  796. end;
  797. procedure TMainForm.MenuItem65Click(Sender: TObject);
  798. begin
  799. ApplyNonLinear(nfMedian, 5);
  800. end;
  801. procedure TMainForm.MenuItem66Click(Sender: TObject);
  802. begin
  803. ApplyNonLinear(nfMin, 3);
  804. end;
  805. procedure TMainForm.MenuItem67Click(Sender: TObject);
  806. begin
  807. ApplyNonLinear(nfMin, 5);
  808. end;
  809. procedure TMainForm.MenuItem68Click(Sender: TObject);
  810. begin
  811. ApplyNonLinear(nfMax, 3);
  812. end;
  813. procedure TMainForm.MenuItem69Click(Sender: TObject);
  814. begin
  815. ApplyNonLinear(nfMax, 5);
  816. end;
  817. procedure TMainForm.MenuItem71Click(Sender: TObject);
  818. begin
  819. ApplyMorphology(mpErode);
  820. end;
  821. procedure TMainForm.MenuItem72Click(Sender: TObject);
  822. begin
  823. ApplyMorphology(mpDilate);
  824. end;
  825. procedure TMainForm.MenuItem73Click(Sender: TObject);
  826. begin
  827. ApplyMorphology(mpOpen);
  828. end;
  829. procedure TMainForm.MenuItem74Click(Sender: TObject);
  830. begin
  831. ApplyMorphology(mpClose);
  832. end;
  833. procedure TMainForm.MenuItem75Click(Sender: TObject);
  834. begin
  835. ApplyPointTransform(ptLevelsLow);
  836. end;
  837. procedure TMainForm.MenuItem76Click(Sender: TObject);
  838. begin
  839. ApplyPointTransform(ptLevelsHigh);
  840. end;
  841. procedure TMainForm.MenuItem78Click(Sender: TObject);
  842. begin
  843. ApplyPointTransform(ptAlphaPreMult);
  844. end;
  845. procedure TMainForm.MenuItem79Click(Sender: TObject);
  846. begin
  847. ApplyPointTransform(ptAlphaUnPreMult);
  848. end;
  849. procedure TMainForm.MenuItem7Click(Sender: TObject);
  850. begin
  851. Close;
  852. end;
  853. procedure TMainForm.OpenFile(const FileName: string);
  854. var
  855. T: Int64;
  856. begin
  857. FFileName := FileName;
  858. try
  859. T := GetTimeMicroseconds;
  860. FImage.LoadMultiFromFile(FileName);
  861. MeasureTime(Format('File %s opened in:', [ExtractFileName(FileName)]), T);
  862. except
  863. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  864. FImage.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  865. end;
  866. SelectSubimage(0);
  867. end;
  868. procedure TMainForm.SaveFile(const FileName: string);
  869. var
  870. T: Int64;
  871. begin
  872. try
  873. T := GetTimeMicroseconds;
  874. FImage.SaveMultiToFile(FileName);
  875. MeasureTime(Format('File %s saved in:', [ExtractFileName(FileName)]), T);
  876. except
  877. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  878. end;
  879. end;
  880. procedure TMainForm.SelectSubimage(Index: LongInt);
  881. begin
  882. FImage.ActiveImage := Index;
  883. MenuItemActSubImage.Caption := Format('Active Subimage: %d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]);
  884. UpdateView;
  885. end;
  886. procedure TMainForm.UpdateView;
  887. begin
  888. Image.Picture.Graphic.Assign(FImage);
  889. end;
  890. procedure TMainForm.MeasureTime(const Msg: string; const OldTime: Int64);
  891. begin
  892. PanelStatus.Caption := Format(' %s %.0n ms', [Msg, (GetTimeMicroseconds - OldTime) / 1000.0]);
  893. end;
  894. initialization
  895. {$I mainunit.lrs}
  896. {
  897. File Notes:
  898. -- TODOS ----------------------------------------------------
  899. - add more canvas stuff when it will be avaiable
  900. -- 0.26.3 Changes/Bug Fixes ---------------------------------
  901. - Added Free Resize and Free Rotate functions to Manipulate menu.
  902. - Added premult/unpremult alpha point transforms.
  903. -- 0.26.1 Changes/Bug Fixes ---------------------------------
  904. - Added "show histogram" menu item and functionality.
  905. - Added new Colors submenu with "set channel set value" commands.
  906. - Added Canvas.AdjustColorLevels example.
  907. -- 0.25.0 Changes/Bug Fixes ---------------------------------
  908. - Added binary morphology operations.
  909. - Added point transforms and non-linear filters.
  910. -- 0.24.1 Changes/Bug Fixes ---------------------------------
  911. - Added status bar which shows times taken by some oprations.
  912. - Reworked manipulation commands to get rid of UpdateView calls
  913. everywhere.
  914. - With Lazarus 0.9.24 images are now displayed with
  915. proper transparency (those with alpha). Also it doesn't
  916. screw up some images with 'Fit to window' so that is now
  917. default.
  918. -- 0.23 Changes/Bug Fixes -----------------------------------
  919. - Catches exceptions during file load/save.
  920. -- 0.21 Changes/Bug Fixes -----------------------------------
  921. - Save As... now saves all images levels instead of just current one.
  922. - Added XP controls manifest to resource file.
  923. - Added new filters to Effects menu.
  924. -- 0.19 Changes/Bug Fixes -----------------------------------
  925. - you can now open image in Imager from shell by passing
  926. path to image as parameter: 'LCLImager /home/myimage.jpg'
  927. - added Reload from File menu to reload image from disk
  928. (poor man's Undo)
  929. - added Effects menu with some convolution filters
  930. - added support for displaying of multi images
  931. -- 0.17 Changes/Bug Fixes -----------------------------------
  932. - added Nearest, Bilinear, and Bicubic filter options to
  933. Resize To 50/200% menu items
  934. - better handling of file exts when using save dialog
  935. - added rotations to Manipulate menu
  936. - now works well in Linux too
  937. -- 0.15 Changes/Bug Fixes -----------------------------------
  938. - created
  939. }
  940. end.