mainunit.pas 37 KB

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