DemoUnit.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
  1. {
  2. Vampyre Imaging Library Demo
  3. Vampyre Image Converter (core low level API)
  4. Image Converter is command line tool for converting images between
  5. file and data formats. It also provides some basic manipulation functions
  6. like resizing, rotating, or color reduction.
  7. See PrintUsage procedure for usage details (or just run binary without parameters).
  8. Note: Operations (change format, resize, rotate) are processed in the same order
  9. as they appear on the command line.
  10. }
  11. unit DemoUnit;
  12. {$I ImagingOptions.inc}
  13. interface
  14. procedure RunDemo;
  15. implementation
  16. uses
  17. SysUtils,
  18. Classes,
  19. ImagingTypes,
  20. Imaging,
  21. ImagingUtility;
  22. const
  23. DefaultOutputFile = 'output.png';
  24. DefaultFileFormat = 'png';
  25. var
  26. InFile, OutFile: string;
  27. Operations: TStringList;
  28. procedure PrintHeader;
  29. begin
  30. WriteLn('Vampyre Image Converter (library version ', Imaging.GetVersionStr, ')');
  31. WriteLn('by Marek Mauder');
  32. WriteLn;
  33. end;
  34. procedure PrintUsage;
  35. type
  36. TFormatInfo = record
  37. Ext: string;
  38. CanSave: Boolean;
  39. end;
  40. var
  41. I: LongInt;
  42. FmtIter: TImageFormat;
  43. Info: TImageFormatInfo;
  44. Name, Ext, Masks: string;
  45. CanSave, IsMulti: Boolean;
  46. FileFormats: array of TFormatInfo;
  47. begin
  48. WriteLn('Usage:');
  49. WriteLn('VampConvert [-op=arg] [..] -infile=file.ext [..] [-outfile=file.ext] [-op=arg]');
  50. WriteLn(' Options:');
  51. WriteLn(' -infile | -i: specify input image file path');
  52. WriteLn(' -outfile | -o: specify output image file path');
  53. WriteLn(' argument: file path or "*.ext" where input file name will be used ');
  54. WriteLn(' but with "ext" extension');
  55. WriteLn(' Operations:');
  56. WriteLn(' Note: they are processed in the same order as they appear on command line');
  57. WriteLn(' -format: changes data format of input images');
  58. WriteLn(' argument: name of data format supported by Imaging like A8R8G8B8');
  59. WriteLn(' -resize: changes size of input images');
  60. WriteLn(' argument: string in format AxBxC (%dx%dx%s) where A is desired');
  61. WriteLn(' width, B is desired height, and C is resampling filter used.');
  62. WriteLn(' If A or B is 0 then original dimension will be preserved.');
  63. WriteLn(' C is optional and can have one of following values: ');
  64. WriteLn(' nearest(default), bilinear, bicubic, lanczos.');
  65. WriteLn(' -flip: flips input images upside down');
  66. WriteLn(' -mirror: mirrors input images left to right');
  67. WriteLn(' -colorcount: reduces number of colors in image');
  68. WriteLn(' argument: number of desired colors (2-4096)');
  69. WriteLn(' -genmipmaps: generates mipmaps for main image');
  70. WriteLn(' argument: number of desired mip levels. 0 or no arg means');
  71. WriteLn(' create all possible levels');
  72. WriteLn(' -rotate: rotates input images counterclockwise');
  73. WriteLn(' argument: angle in degrees (integer)');
  74. // Enumerate all supported file formats and store default ext and
  75. // their capability to save files to string list.
  76. I := 0;
  77. while EnumFileFormats(I, Name, Ext, Masks, CanSave, IsMulti) do
  78. begin
  79. SetLength(FileFormats, I);
  80. FileFormats[I - 1].Ext := Ext;
  81. FileFormats[I - 1].CanSave := CanSave;
  82. end;
  83. // Print all file formats that support loading files (just write all)
  84. WriteLn;
  85. WriteLn(' Supported file formats (INPUT):');
  86. for I := 0 to High(FileFormats) do
  87. Write(FileFormats[I].Ext, ' ');
  88. WriteLn;
  89. // Print all file formats that support saving files
  90. WriteLn(' Supported file formats (OUTPUT):');
  91. for I := 0 to High(FileFormats) do
  92. begin
  93. if FileFormats[I].CanSave then
  94. Write(FileFormats[I].Ext, ' ');
  95. end;
  96. WriteLn;
  97. // Iterate over all image data formats and write their names
  98. Write(' Supported data formats: ');
  99. for FmtIter := ifIndex8 to High(TImageFormat) do
  100. begin
  101. if Imaging.GetImageFormatInfo(FmtIter, Info) then
  102. Write(Info.Name, ' ');
  103. end;
  104. end;
  105. procedure PrintError(const Msg: string; const Args: array of const);
  106. begin
  107. WriteLn(Format('Error: ' + Msg, Args));
  108. WriteLn;
  109. PrintUsage;
  110. Operations.Free;
  111. Halt(1);
  112. end;
  113. procedure PrintWarning(const Msg: string; const Args: array of const);
  114. begin
  115. WriteLn(Format('Warning: ' + Msg, Args));
  116. end;
  117. procedure PrintInfo(const Msg: string; const Args: array of const);
  118. begin
  119. WriteLn(Format('Info: ' + Msg, Args));
  120. end;
  121. procedure ParseCommandLine;
  122. var
  123. I: LongInt;
  124. procedure ParseOption(const Opt: string);
  125. var
  126. I: LongInt;
  127. S, Arg: string;
  128. begin
  129. S := Opt;
  130. I := Pos('=', S);
  131. if I > 0 then
  132. Arg := Copy(S, I + 1, MaxInt)
  133. else
  134. Arg := 'none';
  135. Delete(S, I, MaxInt);
  136. Delete(S, 1, 1);
  137. S := LowerCase(S);
  138. if (S = 'infile') or (S = 'i') then
  139. InFile := Arg
  140. else if (S = 'outfile') or (S = 'o') then
  141. OutFile := Arg
  142. else
  143. Operations.Add(Format('%s=%s', [S, LowerCase(Arg)]));
  144. end;
  145. begin
  146. for I := 1 to ParamCount do
  147. ParseOption(ParamStr(I));
  148. end;
  149. procedure CheckOptions;
  150. var
  151. InFileName, InFileDir: string;
  152. begin
  153. // Check if input and input filenames are valid
  154. if InFile = '' then
  155. PrintError('Input file not specified', []);
  156. if not FileExists(InFile) then
  157. PrintError('Input file not found: "%s"', [InFile]);
  158. if not Imaging.IsFileFormatSupported(InFile) then
  159. PrintError('Input file format not supported: %s', [ImagingUtility.GetFileExt(InFile)]);
  160. if OutFile = '' then
  161. begin
  162. PrintWarning('Output file not specified, using default: %s (in current directory)',
  163. [DefaultOutputFile]);
  164. OutFile := DefaultOutputFile;
  165. end;
  166. InFileName := ExtractFileName(InFile);
  167. InFileDir := ExtractFileDir(InFile);
  168. InFileDir := Iff(InFileDir <> '', PathDelim, InFileDir);
  169. // If outpout filename is in format "*.ext" then input filename is used
  170. // but with "ext" extension
  171. if ChangeFileExt(ExtractFileName(OutFile), '') = '*' then
  172. OutFile := InFileDir + ChangeFileExt(InFileName, ExtractFileExt(OutFile));
  173. if not Imaging.IsFileFormatSupported(OutFile) then
  174. begin
  175. PrintWarning('Output file format not supported, using default: %s',
  176. [DefaultFileFormat]);
  177. OutFile := InFileDir + ChangeFileExt(InFileName, '.' + DefaultFileFormat);
  178. end;
  179. end;
  180. procedure ProcessOperations;
  181. var
  182. I, J, X, Y, NewWidth, NewHeight: LongInt;
  183. OpName, Arg, S: string;
  184. Images: TDynImageDataArray;
  185. Format: TImageFormat;
  186. ResFilter: TResizeFilter;
  187. MainImage: TImageData;
  188. procedure PrintInvalidArg(const OpName, Arg: string);
  189. begin
  190. PrintError('Invalid argument (%s) for operation: %s', [Arg, OpName]);
  191. end;
  192. function FindFormat(const FmtString: string): TImageFormat;
  193. var
  194. I: TImageFormat;
  195. Name: string;
  196. begin
  197. Result := ifUnknown;
  198. for I := ifIndex8 to High(TImageFormat) do
  199. begin
  200. Name := Imaging.GetFormatName(I);
  201. if SameText(FmtString, Name) or SameText(FmtString, 'if' + Name) then
  202. begin
  203. Result := I;
  204. Exit;
  205. end;
  206. end;
  207. end;
  208. begin
  209. Operations.NameValueSeparator := '=';
  210. InitImage(MainImage);
  211. try
  212. // Load input image
  213. if not Imaging.LoadMultiImageFromFile(InFile, Images) then
  214. PrintError('Input file loading failed: %s', [ImagingUtility.GetExceptObject.Message]);
  215. // Check if all loaded images are OK or if they are any at all
  216. if (Length(Images) = 0) or not Imaging.TestImagesInArray(Images) then
  217. PrintError('Input file loaded but it does not contain any images or some of them are invalid', []);
  218. PrintInfo('Input images (count: %d) loaded succesfully from: %s', [Length(Images), InFile]);
  219. // Now process operations one by one
  220. for I := 0 to Operations.Count - 1 do
  221. begin
  222. // Get operation name and argument
  223. OpName := Operations.Names[I];
  224. Arg := Operations.ValueFromIndex[I];
  225. if OpName = 'format' then
  226. begin
  227. // Check if argument is name of some data format
  228. Format := FindFormat(Arg);
  229. if Format = ifUnknown then
  230. PrintInvalidArg(OpName, Arg);
  231. // If some format was found then all images are converted to it
  232. PrintInfo('Converting images to data format: %s', [Imaging.GetFormatName(Format)]);
  233. for J := 0 to High(Images) do
  234. Imaging.ConvertImage(Images[J], Format);
  235. end
  236. else if OpName = 'resize' then
  237. begin
  238. // Parse argument in format %dx%d[x%s]
  239. J := Pos('x', Arg);
  240. if J = 0 then
  241. PrintInvalidArg(OpName, Arg);
  242. X := StrToIntDef(Copy(Arg, 1, J - 1), Images[0].Width);
  243. Delete(Arg, 1, J);
  244. J := Pos('x', Arg);
  245. S := 'nearest';
  246. if J <> 0 then
  247. begin
  248. S := Copy(Arg, J + 1, MaxInt);
  249. Delete(Arg, J, MaxInt);
  250. end;
  251. Y := StrToIntDef(Arg, 0);
  252. // Limit new dimensions and convert
  253. // invalid dimensions are set to 0 which is special value (later)
  254. X := ClampInt(X, 0, 32768);
  255. Y := ClampInt(Y, 0, 32768);
  256. // Select filtering method used for resizing according to argument
  257. ResFilter := rfNearest;
  258. if Pos('bil', S) = 1 then
  259. ResFilter := rfBilinear
  260. else if Pos('bic', S) = 1 then
  261. ResFilter := rfBicubic
  262. else if Pos('lan', S) = 1 then
  263. ResFilter := rfLanczos;
  264. PrintInfo('Resizing images to %dx%d using [%s] filter: ', [X, Y, S]);
  265. for J := 0 to High(Images) do
  266. begin
  267. // If any of new dimensions is 0 we use the original dimension
  268. // of image
  269. NewWidth := Iff(X = 0, Images[J].Width, X);
  270. NewHeight := Iff(Y = 0, Images[J].Height, Y);
  271. Imaging.ResizeImage(Images[J], NewWidth, NewHeight, ResFilter);
  272. end;
  273. end
  274. else if OpName = 'flip' then
  275. begin
  276. // Simply flip all images
  277. PrintInfo('Flipping images upside down', []);
  278. for J := 0 to High(Images) do
  279. Imaging.FlipImage(Images[J]);
  280. end
  281. else if OpName = 'mirror' then
  282. begin
  283. // Simply mirror all images
  284. PrintInfo('Mirroring images left to right', []);
  285. for J := 0 to High(Images) do
  286. Imaging.MirrorImage(Images[J]);
  287. end
  288. else if OpName = 'colorcount' then
  289. begin
  290. // Get value of the argument ...
  291. if not TryStrToInt(Arg, X) then
  292. PrintInvalidArg(OpName, Arg);
  293. X := ClampInt(X, 2, 4096);
  294. PrintInfo('Reducing color count of images to: %d', [X]);
  295. // ... and reduce number of colors of all images
  296. for J := 0 to High(Images) do
  297. Imaging.ReduceColors(Images[J], X);
  298. end
  299. else if OpName = 'genmipmaps' then
  300. begin
  301. // Get number of mipmaps from argument or use
  302. // default 0 which means "create all mip levels you can"
  303. X := StrToIntDef(Arg, 0);
  304. PrintInfo('Generating mipmaps for main image', []);
  305. // Clone main image and use input array as the output of
  306. // mipmap generation function
  307. Imaging.CloneImage(Images[0], MainImage);
  308. Imaging.GenerateMipMaps(MainImage, X, Images);
  309. end
  310. else if OpName = 'rotate' then
  311. begin
  312. // Parse argument, only integer degrees are allowed
  313. if not TryStrToInt(Arg, X) then
  314. PrintInvalidArg(OpName, Arg);
  315. PrintInfo('Rotating images: %d degrees CCW', [X]);
  316. // Rotate all
  317. for J := 0 to High(Images) do
  318. Imaging.RotateImage(Images[J], X);
  319. end
  320. else
  321. begin
  322. // Warn about unknown operations passed to program
  323. PrintWarning('Unrecognized operation: ' + OpName, []);
  324. end;
  325. end;
  326. // Copy metadata if present
  327. GlobalMetadata.CopyLoadedMetaItemsForSaving;
  328. // Finally save the result
  329. if not Imaging.SaveMultiImageToFile(OutFile, Images) then
  330. PrintError('Output file saving failed: %s', [ImagingUtility.GetExceptObject.Message])
  331. else
  332. PrintInfo('Output images saved succesfully to: %s', [OutFile])
  333. finally
  334. // Free images in array as well as temp image
  335. Imaging.FreeImagesInArray(Images);
  336. Imaging.FreeImage(MainImage);
  337. end;
  338. end;
  339. procedure RunDemo;
  340. begin
  341. PrintHeader;
  342. Operations := TStringList.Create;
  343. ParseCommandLine;
  344. CheckOptions;
  345. try
  346. ProcessOperations;
  347. except
  348. PrintError('Exception raised during processing oprations: %s',
  349. [ImagingUtility.GetExceptObject.Message]);
  350. end;
  351. Operations.Free;
  352. end;
  353. {
  354. File Notes:
  355. -- TODOS ----------------------------------------------------
  356. - more operations
  357. - allow changing ImagingOptions too
  358. -- 0.80 -----------------------------------------------------
  359. - Added Lanczos as a resampling option
  360. - Removed no longer required limit on rotation angles to be multimples of 90.
  361. -- 0.77.1 ---------------------------------------------------
  362. - Refactored the demo (moved stuff to unit from dpr) and
  363. added Lazarus project files.
  364. -- 0.21 Changes/Bug Fixes -----------------------------------
  365. - added -i and -o shortcut cmd line parameters and fixed
  366. FPC 32/64 bit compatibility issue
  367. - List of supported file formats printed by PrintUsage is now
  368. dynamic and shows input and output formats separately
  369. -- 0.19 Changes/Bug Fixes -----------------------------------
  370. - demo created
  371. }
  372. end.