mainunit.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989
  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. mtResize50Nearest, mtResize50Linear, mtResize50Cubic,
  39. mtResize200Nearest, mtResize200Linear, mtResize200Cubic,
  40. mtSwapRB, mtSwapRG, mtSwapGB, mtReduce1024,
  41. mtReduce256, mtReduce64, mtReduce16, mtReduce2);
  42. TPointTransform = (ptInvert, ptIncContrast, ptDecContrast, ptIncBrightness,
  43. ptDecBrightness, ptIncGamma, ptDecGamma, ptThreshold, ptLevelsLow, ptLevelsHigh);
  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. RedItem: TMenuItem;
  126. GreenItem: TMenuItem;
  127. BlueItem: TMenuItem;
  128. MenuItem82: TMenuItem;
  129. MenuItemActSubImage: TMenuItem;
  130. MenuItem34: TMenuItem;
  131. MenuItem35: TMenuItem;
  132. MenuItem4: TMenuItem;
  133. MenuItem5: TMenuItem;
  134. MenuItem6: TMenuItem;
  135. MenuItem7: TMenuItem;
  136. MenuItem8: TMenuItem;
  137. MenuItem9: TMenuItem;
  138. OpenD: TOpenPictureDialog;
  139. PanelStatus: TPanel;
  140. SaveD: TSavePictureDialog;
  141. procedure ActViewFitToWindowExecute(Sender: TObject);
  142. procedure ActViewInfoExecute(Sender: TObject);
  143. procedure ActViewRealSizeExecute(Sender: TObject);
  144. procedure FormCreate(Sender: TObject);
  145. procedure FormDestroy(Sender: TObject);
  146. procedure ImageClick(Sender: TObject);
  147. procedure MenuItem10Click(Sender: TObject);
  148. procedure MenuItem12Click(Sender: TObject);
  149. procedure MenuItem13Click(Sender: TObject);
  150. procedure MenuItem14Click(Sender: TObject);
  151. procedure MenuItem15Click(Sender: TObject);
  152. procedure MenuItem18Click(Sender: TObject);
  153. procedure MenuItem19Click(Sender: TObject);
  154. procedure MenuItem20Click(Sender: TObject);
  155. procedure MenuItem23Click(Sender: TObject);
  156. procedure MenuItem24Click(Sender: TObject);
  157. procedure MenuItem26Click(Sender: TObject);
  158. procedure MenuItem27Click(Sender: TObject);
  159. procedure MenuItem28Click(Sender: TObject);
  160. procedure MenuItem29Click(Sender: TObject);
  161. procedure MenuItem2Click(Sender: TObject);
  162. procedure MenuItem30Click(Sender: TObject);
  163. procedure MenuItem31Click(Sender: TObject);
  164. procedure MenuItem33Click(Sender: TObject);
  165. procedure MenuItem34Click(Sender: TObject);
  166. procedure MenuItem35Click(Sender: TObject);
  167. procedure MenuItem37Click(Sender: TObject);
  168. procedure MenuItem38Click(Sender: TObject);
  169. procedure MenuItem39Click(Sender: TObject);
  170. procedure MenuItem3Click(Sender: TObject);
  171. procedure MenuItem40Click(Sender: TObject);
  172. procedure MenuItem41Click(Sender: TObject);
  173. procedure MenuItem42Click(Sender: TObject);
  174. procedure MenuItem43Click(Sender: TObject);
  175. procedure MenuItem44Click(Sender: TObject);
  176. procedure MenuItem45Click(Sender: TObject);
  177. procedure MenuItem46Click(Sender: TObject);
  178. procedure MenuItem47Click(Sender: TObject);
  179. procedure MenuItem48Click(Sender: TObject);
  180. procedure MenuItem4Click(Sender: TObject);
  181. procedure MenuItem50Click(Sender: TObject);
  182. procedure MenuItem51Click(Sender: TObject);
  183. procedure MenuItem53Click(Sender: TObject);
  184. procedure MenuItem54Click(Sender: TObject);
  185. procedure MenuItem56Click(Sender: TObject);
  186. procedure MenuItem57Click(Sender: TObject);
  187. procedure MenuItem58Click(Sender: TObject);
  188. procedure MenuItem59Click(Sender: TObject);
  189. procedure MenuItem5Click(Sender: TObject);
  190. procedure MenuItem60Click(Sender: TObject);
  191. procedure MenuItem61Click(Sender: TObject);
  192. procedure MenuItem62Click(Sender: TObject);
  193. procedure MenuItem64Click(Sender: TObject);
  194. procedure MenuItem65Click(Sender: TObject);
  195. procedure MenuItem66Click(Sender: TObject);
  196. procedure MenuItem67Click(Sender: TObject);
  197. procedure MenuItem68Click(Sender: TObject);
  198. procedure MenuItem69Click(Sender: TObject);
  199. procedure MenuItem71Click(Sender: TObject);
  200. procedure MenuItem72Click(Sender: TObject);
  201. procedure MenuItem73Click(Sender: TObject);
  202. procedure MenuItem74Click(Sender: TObject);
  203. procedure MenuItem75Click(Sender: TObject);
  204. procedure MenuItem76Click(Sender: TObject);
  205. procedure MenuItem7Click(Sender: TObject);
  206. procedure FormatChangeClick(Sender: TObject);
  207. procedure ChannelSetClick(Sender: TObject);
  208. procedure MenuItem82Click(Sender: TObject);
  209. private
  210. FBitmap: TImagingBitmap;
  211. FImage: TMultiImage;
  212. FImageCanvas: TImagingCanvas;
  213. FFileName: string;
  214. procedure OpenFile(const FileName: string);
  215. procedure SaveFile(const FileName: string);
  216. procedure SelectSubimage(Index: LongInt);
  217. procedure UpdateView;
  218. function CheckCanvasFormat: Boolean;
  219. procedure ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  220. procedure ApplyPointTransform(Transform: TPointTransform);
  221. procedure ApplyManipulation(ManipType: TManipulationType);
  222. procedure ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  223. procedure ApplyMorphology(MorphOp: TMorphology);
  224. procedure MeasureTime(const Msg: string; const OldTime: Int64);
  225. public
  226. end;
  227. const
  228. SWindowTitle = 'LCL Imager - Vampyre Imaging Library %s Demo';
  229. var
  230. MainForm: TMainForm;
  231. implementation
  232. { TMainForm }
  233. procedure TMainForm.MenuItem10Click(Sender: TObject);
  234. begin
  235. AboutForm.ShowModal;
  236. end;
  237. procedure TMainForm.MenuItem12Click(Sender: TObject);
  238. begin
  239. ApplyManipulation(mtSwapRB);
  240. end;
  241. procedure TMainForm.MenuItem13Click(Sender: TObject);
  242. begin
  243. ApplyManipulation(mtSwapRG);
  244. end;
  245. procedure TMainForm.MenuItem14Click(Sender: TObject);
  246. begin
  247. ApplyManipulation(mtSwapGB);
  248. end;
  249. procedure TMainForm.MenuItem15Click(Sender: TObject);
  250. begin
  251. ApplyManipulation(mtReduce1024);
  252. end;
  253. procedure TMainForm.MenuItem18Click(Sender: TObject);
  254. begin
  255. ApplyManipulation(mtReduce256);
  256. end;
  257. procedure TMainForm.MenuItem19Click(Sender: TObject);
  258. begin
  259. ApplyManipulation(mtReduce64);
  260. end;
  261. procedure TMainForm.MenuItem20Click(Sender: TObject);
  262. begin
  263. ApplyManipulation(mtReduce16);
  264. end;
  265. procedure TMainForm.MenuItem4Click(Sender: TObject);
  266. begin
  267. ApplyManipulation(mtMirror);
  268. end;
  269. procedure TMainForm.MenuItem23Click(Sender: TObject);
  270. begin
  271. ApplyManipulation(mtRotate90CW);
  272. end;
  273. procedure TMainForm.MenuItem24Click(Sender: TObject);
  274. begin
  275. ApplyManipulation(mtRotate90CCW);
  276. end;
  277. procedure TMainForm.MenuItem26Click(Sender: TObject);
  278. begin
  279. ApplyManipulation(mtResize50Nearest);
  280. end;
  281. procedure TMainForm.MenuItem27Click(Sender: TObject);
  282. begin
  283. ApplyManipulation(mtResize50Linear);
  284. end;
  285. procedure TMainForm.MenuItem28Click(Sender: TObject);
  286. begin
  287. ApplyManipulation(mtResize50Cubic);
  288. end;
  289. procedure TMainForm.MenuItem29Click(Sender: TObject);
  290. begin
  291. ApplyManipulation(mtResize200Nearest);
  292. end;
  293. procedure TMainForm.MenuItem2Click(Sender: TObject);
  294. begin
  295. ApplyManipulation(mtFlip);
  296. end;
  297. procedure TMainForm.MenuItem30Click(Sender: TObject);
  298. begin
  299. ApplyManipulation(mtResize200Linear);
  300. end;
  301. procedure TMainForm.MenuItem31Click(Sender: TObject);
  302. begin
  303. ApplyManipulation(mtResize200Cubic);
  304. end;
  305. procedure TMainForm.MenuItem33Click(Sender: TObject);
  306. begin
  307. ApplyManipulation(mtReduce2);
  308. end;
  309. procedure TMainForm.MenuItem37Click(Sender: TObject);
  310. begin
  311. ApplyConvolution(@FilterGaussian3x3, 3, False);
  312. end;
  313. procedure TMainForm.MenuItem38Click(Sender: TObject);
  314. begin
  315. ApplyConvolution(@FilterGaussian5x5, 5, False);
  316. end;
  317. procedure TMainForm.MenuItem39Click(Sender: TObject);
  318. begin
  319. ApplyConvolution(@FilterSharpen3x3, 3, False);
  320. end;
  321. procedure TMainForm.MenuItem40Click(Sender: TObject);
  322. begin
  323. ApplyConvolution(@FilterSharpen5x5, 5, False);
  324. end;
  325. procedure TMainForm.MenuItem41Click(Sender: TObject);
  326. begin
  327. ApplyConvolution(@FilterLaplace5x5, 5, True);
  328. end;
  329. procedure TMainForm.MenuItem42Click(Sender: TObject);
  330. begin
  331. ApplyConvolution(@FilterSobelHorz3x3, 3, True);
  332. end;
  333. procedure TMainForm.MenuItem43Click(Sender: TObject);
  334. begin
  335. ApplyConvolution(@FilterSobelVert3x3, 3, True);
  336. end;
  337. procedure TMainForm.MenuItem44Click(Sender: TObject);
  338. begin
  339. OpenFile(FFileName);
  340. end;
  341. procedure TMainForm.MenuItem45Click(Sender: TObject);
  342. begin
  343. ApplyConvolution(@FilterGlow5x5, 5, False);
  344. end;
  345. procedure TMainForm.MenuItem46Click(Sender: TObject);
  346. begin
  347. ApplyConvolution(@FilterEmboss3x3, 3, True);
  348. end;
  349. procedure TMainForm.MenuItem47Click(Sender: TObject);
  350. begin
  351. ApplyPointTransform(ptIncContrast);
  352. end;
  353. procedure TMainForm.MenuItem48Click(Sender: TObject);
  354. begin
  355. ApplyConvolution(@FilterEdgeEnhance3x3, 3, False);
  356. end;
  357. procedure TMainForm.MenuItem50Click(Sender: TObject);
  358. begin
  359. ApplyConvolution(@FilterPrewittHorz3x3, 3, True);
  360. end;
  361. procedure TMainForm.MenuItem51Click(Sender: TObject);
  362. begin
  363. ApplyConvolution(@FilterKirshHorz3x3, 3, True);
  364. end;
  365. procedure TMainForm.MenuItem53Click(Sender: TObject);
  366. begin
  367. ApplyConvolution(@FilterPrewittVert3x3, 3, True);
  368. end;
  369. procedure TMainForm.MenuItem54Click(Sender: TObject);
  370. begin
  371. ApplyConvolution(@FilterKirshVert3x3, 3, True);
  372. end;
  373. procedure TMainForm.MenuItem56Click(Sender: TObject);
  374. begin
  375. ApplyPointTransform(ptInvert);
  376. end;
  377. procedure TMainForm.MenuItem57Click(Sender: TObject);
  378. begin
  379. ApplyPointTransform(ptDecContrast);
  380. end;
  381. procedure TMainForm.MenuItem58Click(Sender: TObject);
  382. begin
  383. ApplyPointTransform(ptIncBrightness);
  384. end;
  385. procedure TMainForm.MenuItem59Click(Sender: TObject);
  386. begin
  387. ApplyPointTransform(ptDecBrightness);
  388. end;
  389. procedure TMainForm.MenuItem34Click(Sender: TObject);
  390. begin
  391. SelectSubimage(FImage.ActiveImage + 1);
  392. end;
  393. procedure TMainForm.MenuItem35Click(Sender: TObject);
  394. begin
  395. SelectSubimage(FImage.ActiveImage - 1);
  396. end;
  397. function TMainForm.CheckCanvasFormat: Boolean;
  398. begin
  399. Result := FImage.Format in FImageCanvas.GetSupportedFormats;
  400. if not Result then
  401. MessageDlg('Image is in format that is not supported by TImagingCanvas.', mtError, [mbOK], 0);
  402. end;
  403. procedure TMainForm.ApplyConvolution(Kernel: Pointer; Size: LongInt; NeedsBlur: Boolean);
  404. var
  405. T: Int64;
  406. begin
  407. if CheckCanvasFormat then
  408. begin
  409. FImageCanvas.CreateForImage(FImage);
  410. T := GetTimeMicroseconds;
  411. if NeedsBlur then
  412. FImageCanvas.ApplyConvolution3x3(FilterGaussian3x3);
  413. if Size = 3 then
  414. FImageCanvas.ApplyConvolution3x3(TConvolutionFilter3x3(Kernel^))
  415. else
  416. FImageCanvas.ApplyConvolution5x5(TConvolutionFilter5x5(Kernel^));
  417. MeasureTime('Image convolved in:', T);
  418. UpdateView;
  419. end;
  420. end;
  421. procedure TMainForm.ApplyPointTransform(Transform: TPointTransform);
  422. var
  423. T: Int64;
  424. begin
  425. if CheckCanvasFormat then
  426. begin
  427. FImageCanvas.CreateForImage(FImage);
  428. T := GetTimeMicroseconds;
  429. case Transform of
  430. ptInvert: FImageCanvas.InvertColors;
  431. ptIncContrast: FImageCanvas.ModifyContrastBrightness(20, 0);
  432. ptDecContrast: FImageCanvas.ModifyContrastBrightness(-20, 0);
  433. ptIncBrightness: FImageCanvas.ModifyContrastBrightness(0, 20);
  434. ptDecBrightness: FImageCanvas.ModifyContrastBrightness(0, -20);
  435. ptIncGamma: FImageCanvas.GammaCorection(1.2, 1.2, 1.2);
  436. ptDecGamma: FImageCanvas.GammaCorection(0.8, 0.8, 0.8);
  437. ptThreshold: FImageCanvas.Threshold(0.5, 0.5, 0.5);
  438. ptLevelsLow: FImageCanvas.AdjustColorLevels(0.0, 0.5, 1.0);
  439. ptLevelsHigh: FImageCanvas.AdjustColorLevels(0.35, 1.0, 0.9);
  440. end;
  441. MeasureTime('Point transform done in:', T);
  442. UpdateView;
  443. end;
  444. end;
  445. procedure TMainForm.ApplyNonLinear(FilterType: TNonLinearFilter; FilterSize: Integer);
  446. var
  447. T: Int64;
  448. begin
  449. if CheckCanvasFormat then
  450. begin
  451. FImageCanvas.CreateForImage(FImage);
  452. T := GetTimeMicroseconds;
  453. case FilterType of
  454. nfMedian: FImageCanvas.ApplyMedianFilter(FilterSize);
  455. nfMin: FImageCanvas.ApplyMinFilter(FilterSize);
  456. nfMax: FImageCanvas.ApplyMaxFilter(FilterSize);
  457. end;
  458. MeasureTime('Point transform done in:', T);
  459. UpdateView;
  460. end;
  461. end;
  462. procedure TMainForm.ApplyMorphology(MorphOp: TMorphology);
  463. var
  464. T: Int64;
  465. Strel: TStructElement;
  466. begin
  467. T := GetTimeMicroseconds;
  468. OtsuThresholding(FImage.ImageDataPointer^);
  469. SetLength(Strel, 3, 3);
  470. Strel[0, 0] := 0;
  471. Strel[1, 0] := 1;
  472. Strel[2, 0] := 0;
  473. Strel[0, 1] := 1;
  474. Strel[1, 1] := 1;
  475. Strel[2, 1] := 1;
  476. Strel[0, 2] := 0;
  477. Strel[1, 2] := 1;
  478. Strel[2, 2] := 0;
  479. case MorphOp of
  480. mpErode: Morphology(FImage.ImageDataPointer^, Strel, moErode);
  481. mpDilate: Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  482. mpOpen:
  483. begin
  484. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  485. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  486. end;
  487. mpClose:
  488. begin
  489. Morphology(FImage.ImageDataPointer^, Strel, moDilate);
  490. Morphology(FImage.ImageDataPointer^, Strel, moErode);
  491. end;
  492. end;
  493. MeasureTime('Morphology operation applied in:', T);
  494. UpdateView;
  495. end;
  496. procedure TMainForm.ApplyManipulation(ManipType: TManipulationType);
  497. var
  498. T: Int64;
  499. begin
  500. T := GetTimeMicroseconds;
  501. case ManipType of
  502. mtFlip: FImage.Flip;
  503. mtMirror: FImage.Mirror;
  504. mtRotate90CW: FImage.Rotate(-90);
  505. mtRotate90CCW: FImage.Rotate(90);
  506. mtResize50Nearest: FImage.Resize(FImage.Width div 2, FImage.Height div 2, rfNearest);
  507. mtResize50Linear: FImage.Resize(FImage.Width div 2, FImage.Height div 2, rfBilinear);
  508. mtResize50Cubic: FImage.Resize(FImage.Width div 2, FImage.Height div 2, rfBicubic);
  509. mtResize200Nearest: FImage.Resize(FImage.Width * 2, FImage.Height * 2, rfNearest);
  510. mtResize200Linear: FImage.Resize(FImage.Width * 2, FImage.Height * 2, rfBilinear);
  511. mtResize200Cubic: FImage.Resize(FImage.Width * 2, FImage.Height * 2, rfBicubic);
  512. mtSwapRB: FImage.SwapChannels(ChannelRed, ChannelBlue);
  513. mtSwapRG: FImage.SwapChannels(ChannelRed, ChannelGreen);
  514. mtSwapGB: FImage.SwapChannels(ChannelGreen, ChannelBlue);
  515. mtReduce1024: ReduceColors(FImage.ImageDataPointer^, 1024);
  516. mtReduce256: ReduceColors(FImage.ImageDataPointer^, 256);
  517. mtReduce64: ReduceColors(FImage.ImageDataPointer^, 64);
  518. mtReduce16: ReduceColors(FImage.ImageDataPointer^, 16);
  519. mtReduce2: ReduceColors(FImage.ImageDataPointer^, 2);
  520. end;
  521. MeasureTime('Image manipulated in:', T);
  522. UpdateView;
  523. end;
  524. procedure TMainForm.FormCreate(Sender: TObject);
  525. var
  526. Item: TMenuItem;
  527. Fmt: TImageFormat;
  528. Info: TImageFormatInfo;
  529. function Clone(AItem: TMenuItem): TMenuItem;
  530. begin
  531. Result := TMenuItem.Create(MainMenu);
  532. Result.Caption := AItem.Caption;
  533. Result.Tag := AItem.Tag;
  534. Result.OnClick := AItem.OnClick;;
  535. end;
  536. procedure AddSetChannelItem(const Caption: string; Value: Integer);
  537. begin
  538. Item := TMenuItem.Create(MainMenu);
  539. Item.Caption := Caption;
  540. Item.Tag := Value;
  541. Item.OnClick := ChannelSetClick;
  542. AlphaItem.Add(Item);
  543. RedItem.Add(Clone(Item));
  544. GreenItem.Add(Clone(Item));
  545. BlueItem.Add(Clone(Item));
  546. end;
  547. begin
  548. Caption := Format(SWindowTitle, [Imaging.GetVersionStr]);
  549. { Source image and Image's graphic are created and
  550. default image is opened.}
  551. FImage := TMultiImage.Create;
  552. FBitmap := TImagingBitmap.Create;
  553. Image.Picture.Graphic := FBitmap;
  554. FImageCanvas := TImagingCanvas.Create;
  555. { This builds Format submenu containing all possible
  556. image data formats (it dos not start at Low(TImageFormat)
  557. because there are some helper formats). Format for each item
  558. is stored in its Tag for later use in OnClick event.}
  559. for Fmt := ifIndex8 to High(TImageFormat) do
  560. begin
  561. GetImageFormatInfo(Fmt, Info);
  562. if Info.Name <> '' then
  563. begin
  564. Item := TMenuItem.Create(MainMenu);
  565. Item.Caption := Info.Name;
  566. Item.Tag := Ord(Fmt);
  567. Item.OnClick := FormatChangeClick;
  568. FormatItem.Add(Item);
  569. end;
  570. end;
  571. AddSetChannelItem('Set to 5%', 12);
  572. AddSetChannelItem('Set to 50%', 128);
  573. AddSetChannelItem('Set to 100%', 255);
  574. // Set 'Fit to window' mode
  575. ActViewFitToWindowExecute(Self);
  576. if (ParamCount > 0) and FileExists(ParamStr(1)) then
  577. OpenFile(ParamStr(1))
  578. else
  579. OpenFile(GetDataDir + PathDelim + 'Tigers.jpg');
  580. end;
  581. procedure TMainForm.FormatChangeClick(Sender: TObject);
  582. var
  583. T: Int64;
  584. begin
  585. with Sender as TMenuItem do
  586. begin
  587. T := GetTimeMicroseconds;
  588. FImage.Format := TImageFormat(Tag);
  589. MeasureTime('Image converted in:', T);
  590. UpdateView;
  591. end;
  592. end;
  593. procedure TMainForm.ChannelSetClick(Sender: TObject);
  594. var
  595. T: Int64;
  596. Canvas: TImagingCanvas;
  597. ChanId: Integer;
  598. begin
  599. if CheckCanvasFormat then
  600. with Sender as TMenuItem do
  601. begin
  602. case Parent.Caption[1] of
  603. 'A': ChanId := ChannelAlpha;
  604. 'R': ChanId := ChannelRed;
  605. 'G': ChanId := ChannelGreen;
  606. 'B': ChanId := ChannelBlue;
  607. else
  608. ChanId := ChannelRed;
  609. end;
  610. Canvas := TImagingCanvas.CreateForImage(FImage);
  611. T := GetTimeMicroseconds;
  612. Canvas.FillChannel(ChanId, Tag);
  613. MeasureTime('Channel filled in:', T);
  614. Canvas.Free;
  615. UpdateView;
  616. end;
  617. end;
  618. procedure TMainForm.MenuItem82Click(Sender: TObject);
  619. var
  620. T: Int64;
  621. Canvas: TImagingCanvas;
  622. Red, Green, Blue, Alpha, Gray: THistogramArray;
  623. I, MaxPixels: Integer;
  624. Factor: Single;
  625. procedure VisualizeHistogram(const Histo: THistogramArray; Color: TColor32; Offset: Integer);
  626. var
  627. I, J: Integer;
  628. begin
  629. Canvas.PenColor32 := Color;
  630. for I := 0 to 255 do
  631. Canvas.VertLine(I + Offset, 256 - Round(Histo[I] * Factor), 255);
  632. end;
  633. begin
  634. if CheckCanvasFormat then
  635. begin
  636. Canvas := TImagingCanvas.CreateForImage(FImage);
  637. T := GetTimeMicroseconds;
  638. Canvas.GetHistogram(Red, Green, Blue, Alpha, Gray);
  639. MeasureTime('Histograms computed in:', T);
  640. FImage.RecreateImageData(1024, 256, ifA8R8G8B8);
  641. Canvas.UpdateCanvasState;
  642. Canvas.FillColor32 := pcBlack;
  643. Canvas.FillRect(FImage.BoundsRect);
  644. MaxPixels := 0;
  645. for I := 0 to 255 do
  646. if Red[I] > MaxPixels then MaxPixels := Red[I];
  647. for I := 0 to 255 do
  648. if Green[I] > MaxPixels then MaxPixels := Green[I];
  649. for I := 0 to 255 do
  650. if Blue[I] > MaxPixels then MaxPixels := Blue[I];
  651. for I := 0 to 255 do
  652. if Gray[I] > MaxPixels then MaxPixels := Gray[I];
  653. Factor := 256 / MaxPixels;
  654. VisualizeHistogram(Red, pcRed, 0);
  655. VisualizeHistogram(Green, pcGreen, 256);
  656. VisualizeHistogram(Blue, pcBlue, 512);
  657. VisualizeHistogram(Gray, pcGray, 768);
  658. Canvas.Free;
  659. UpdateView;
  660. end;
  661. end;
  662. procedure TMainForm.ActViewRealSizeExecute(Sender: TObject);
  663. begin
  664. ActViewRealSize.Checked := True;
  665. ActViewFitToWindow.Checked := False;
  666. Image.Proportional := False;
  667. Image.Stretch := False;
  668. end;
  669. procedure TMainForm.ActViewFitToWindowExecute(Sender: TObject);
  670. begin
  671. ActViewFitToWindow.Checked := True;
  672. ActViewRealSize.Checked := False;
  673. Image.Proportional := True;
  674. Image.Stretch := True;
  675. end;
  676. procedure TMainForm.ActViewInfoExecute(Sender: TObject);
  677. begin
  678. MessageDlg('Image Info: ' + ImageToStr(FImage.ImageDataPointer^), mtInformation, [mbOK], 0);
  679. end;
  680. procedure TMainForm.FormDestroy(Sender: TObject);
  681. begin
  682. FImageCanvas.Free;
  683. FBitmap.Free;
  684. FImage.Free;
  685. end;
  686. procedure TMainForm.ImageClick(Sender: TObject);
  687. begin
  688. ActViewInfo.Execute;
  689. end;
  690. procedure TMainForm.MenuItem3Click(Sender: TObject);
  691. begin
  692. OpenD.Filter := GetImageFileFormatsFilter(True);
  693. if OpenD.Execute then
  694. OpenFile(OpenD.FileName);
  695. end;
  696. procedure TMainForm.MenuItem5Click(Sender: TObject);
  697. begin
  698. SaveD.Filter := GetImageFileFormatsFilter(False);
  699. SaveD.FileName := ChangeFileExt(ExtractFileName(FFileName), '');
  700. SaveD.FilterIndex := GetFileNameFilterIndex(FFileName, False);
  701. if SaveD.Execute then
  702. begin
  703. FFileName := ChangeFileExt(SaveD.FileName, '.' + GetFilterIndexExtension(SaveD.FilterIndex, False));
  704. SaveFile(FFileName);
  705. end;
  706. end;
  707. procedure TMainForm.MenuItem60Click(Sender: TObject);
  708. begin
  709. ApplyPointTransform(ptIncGamma);
  710. end;
  711. procedure TMainForm.MenuItem61Click(Sender: TObject);
  712. begin
  713. ApplyPointTransform(ptDecGamma);
  714. end;
  715. procedure TMainForm.MenuItem62Click(Sender: TObject);
  716. begin
  717. ApplyPointTransform(ptThreshold);
  718. end;
  719. procedure TMainForm.MenuItem64Click(Sender: TObject);
  720. begin
  721. ApplyNonLinear(nfMedian, 3);
  722. end;
  723. procedure TMainForm.MenuItem65Click(Sender: TObject);
  724. begin
  725. ApplyNonLinear(nfMedian, 5);
  726. end;
  727. procedure TMainForm.MenuItem66Click(Sender: TObject);
  728. begin
  729. ApplyNonLinear(nfMin, 3);
  730. end;
  731. procedure TMainForm.MenuItem67Click(Sender: TObject);
  732. begin
  733. ApplyNonLinear(nfMin, 5);
  734. end;
  735. procedure TMainForm.MenuItem68Click(Sender: TObject);
  736. begin
  737. ApplyNonLinear(nfMax, 3);
  738. end;
  739. procedure TMainForm.MenuItem69Click(Sender: TObject);
  740. begin
  741. ApplyNonLinear(nfMax, 5);
  742. end;
  743. procedure TMainForm.MenuItem71Click(Sender: TObject);
  744. begin
  745. ApplyMorphology(mpErode);
  746. end;
  747. procedure TMainForm.MenuItem72Click(Sender: TObject);
  748. begin
  749. ApplyMorphology(mpDilate);
  750. end;
  751. procedure TMainForm.MenuItem73Click(Sender: TObject);
  752. begin
  753. ApplyMorphology(mpOpen);
  754. end;
  755. procedure TMainForm.MenuItem74Click(Sender: TObject);
  756. begin
  757. ApplyMorphology(mpClose);
  758. end;
  759. procedure TMainForm.MenuItem75Click(Sender: TObject);
  760. begin
  761. ApplyPointTransform(ptLevelsLow);
  762. end;
  763. procedure TMainForm.MenuItem76Click(Sender: TObject);
  764. begin
  765. ApplyPointTransform(ptLevelsHigh);
  766. end;
  767. procedure TMainForm.MenuItem7Click(Sender: TObject);
  768. begin
  769. Close;
  770. end;
  771. procedure TMainForm.OpenFile(const FileName: string);
  772. var
  773. T: Int64;
  774. begin
  775. FFileName := FileName;
  776. try
  777. T := GetTimeMicroseconds;
  778. FImage.LoadMultiFromFile(FileName);
  779. MeasureTime(Format('File %s opened in:', [ExtractFileName(FileName)]), T);
  780. except
  781. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  782. FImage.CreateFromParams(32, 32, ifA8R8G8B8, 1);
  783. end;
  784. SelectSubimage(0);
  785. end;
  786. procedure TMainForm.SaveFile(const FileName: string);
  787. var
  788. T: Int64;
  789. begin
  790. try
  791. T := GetTimeMicroseconds;
  792. FImage.SaveMultiToFile(FileName);
  793. MeasureTime(Format('File %s saved in:', [ExtractFileName(FileName)]), T);
  794. except
  795. MessageDlg(GetExceptObject.Message, mtError, [mbOK], 0);
  796. end;
  797. end;
  798. procedure TMainForm.SelectSubimage(Index: LongInt);
  799. begin
  800. FImage.ActiveImage := Index;
  801. MenuItemActSubImage.Caption := Format('Active Subimage: %d/%d', [FImage.ActiveImage + 1, FImage.ImageCount]);
  802. UpdateView;
  803. end;
  804. procedure TMainForm.UpdateView;
  805. begin
  806. Image.Picture.Graphic.Assign(FImage);
  807. end;
  808. procedure TMainForm.MeasureTime(const Msg: string; const OldTime: Int64);
  809. begin
  810. PanelStatus.Caption := Format(' %s %.0n ms', [Msg, (GetTimeMicroseconds - OldTime) / 1000.0]);
  811. end;
  812. initialization
  813. {$I mainunit.lrs}
  814. {
  815. File Notes:
  816. -- TODOS ----------------------------------------------------
  817. - add more canvas stuff when it will be avaiable
  818. -- 0.26.1 Changes/Bug Fixes ---------------------------------
  819. - Added "show histogram" menu item and functionality.
  820. - Added new Colors submenu with "set channel set value" commands.
  821. - Added Canvas.AdjustColorLevels example.
  822. -- 0.25.0 Changes/Bug Fixes ---------------------------------
  823. - Added binary morphology operations.
  824. - Added point transforms and non-linear filters.
  825. -- 0.24.1 Changes/Bug Fixes ---------------------------------
  826. - Added status bar which shows times taken by some oprations.
  827. - Reworked manipulation commands to get rid of UpdateView calls
  828. everywhere.
  829. - With Lazarus 0.9.24 images are now displayed with
  830. proper transparency (those with alpha). Also it doesn't
  831. screw up some images with 'Fit to window' so that is now
  832. default.
  833. -- 0.23 Changes/Bug Fixes -----------------------------------
  834. - Catches exceptions during file load/save.
  835. -- 0.21 Changes/Bug Fixes -----------------------------------
  836. - Save As... now saves all images levels instead of just current one.
  837. - Added XP controls manifest to resource file.
  838. - Added new filters to Effects menu.
  839. -- 0.19 Changes/Bug Fixes -----------------------------------
  840. - you can now open image in Imager from shell by passing
  841. path to image as parameter: 'LCLImager /home/myimage.jpg'
  842. - added Reload from File menu to reload image from disk
  843. (poor man's Undo)
  844. - added Effects menu with some convolution filters
  845. - added support for displaying of multi images
  846. -- 0.17 Changes/Bug Fixes -----------------------------------
  847. - added Nearest, Bilinear, and Bicubic filter options to
  848. Resize To 50/200% menu items
  849. - better handling of file exts when using save dialog
  850. - added rotations to Manipulate menu
  851. - now works well in Linux too
  852. -- 0.15 Changes/Bug Fixes -----------------------------------
  853. - created
  854. }
  855. end.