DemoUtils.pas 1.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596
  1. unit DemoUtils;
  2. {$I ImagingOptions.inc}
  3. interface
  4. uses
  5. SysUtils,
  6. Classes,
  7. ImagingTypes,
  8. Imaging,
  9. ImagingUtility;
  10. const
  11. SDataDir = 'Data';
  12. SSourceDir = 'Source';
  13. { }
  14. function ExpandFileTo(const FileName, BasePath: string): string;
  15. { }
  16. function SwapPathDelims(const FileName: string; const NewDelim: string = PathDelim): string;
  17. { }
  18. function GetDataDir: string;
  19. { }
  20. function GetRootDir: string;
  21. { Returns next valid image format.}
  22. function NextFormat(Format: TImageFormat): TImageFormat;
  23. implementation
  24. function ExpandFileTo(const FileName, BasePath: string): string;
  25. var
  26. OldPath: string;
  27. begin
  28. GetDir(0, OldPath);
  29. try
  30. if SysUtils.DirectoryExists(BasePath) then
  31. begin
  32. ChDir(BasePath);
  33. Result:= ExpandFileName(FileName);
  34. end
  35. else
  36. Result:=FileName;
  37. finally
  38. ChDir(OldPath);
  39. end;
  40. end;
  41. function SwapPathDelims(const FileName, NewDelim: string): string;
  42. begin
  43. Result := FileName;
  44. Result := StringReplace(Result, '\', NewDelim, [rfReplaceAll]);
  45. Result := StringReplace(Result, '/', NewDelim, [rfReplaceAll]);
  46. end;
  47. function GetDataDir: string;
  48. var
  49. Iter: Integer;
  50. begin
  51. Iter := 0;
  52. Result := GetAppDir;
  53. while not DirectoryExists(Result + PathDelim + SDataDir) and (Iter < 7) do
  54. begin
  55. Result := ExtractFileDir(Result);
  56. Inc(Iter);
  57. end;
  58. Result := Result + PathDelim + SDataDir;
  59. end;
  60. function GetRootDir: string;
  61. var
  62. Iter: Integer;
  63. begin
  64. Iter := 0;
  65. Result := GetAppDir;
  66. while not DirectoryExists(Result + PathDelim + SSourceDir) and (Iter < 7) do
  67. begin
  68. Result := ExtractFileDir(Result);
  69. Inc(Iter);
  70. end;
  71. end;
  72. function NextFormat(Format: TImageFormat): TImageFormat;
  73. var
  74. Info: TImageFormatInfo;
  75. begin
  76. repeat
  77. if Format < High(TImageFormat) then
  78. Format := Succ(Format)
  79. else
  80. Format := ifIndex8;
  81. until GetImageFormatInfo(Format, Info);
  82. Result := Format;
  83. end;
  84. end.