DemoUtils.pas 2.2 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. { }
  13. function ExpandFileTo(const FileName, BasePath: string): string;
  14. { }
  15. function SwapPathDelims(const FileName: string; const NewDelim: string = PathDelim): string;
  16. { }
  17. function GetDataDir: string;
  18. { }
  19. function GetRootDir: string;
  20. { Returns next valid image format.}
  21. function NextFormat(Format: TImageFormat): TImageFormat;
  22. implementation
  23. function ExpandFileTo(const FileName, BasePath: string): string;
  24. var
  25. OldPath: string;
  26. begin
  27. GetDir(0, OldPath);
  28. try
  29. if SysUtils.DirectoryExists(BasePath) then
  30. begin
  31. ChDir(BasePath);
  32. Result:= ExpandFileName(FileName);
  33. end
  34. else
  35. Result:=FileName;
  36. finally
  37. ChDir(OldPath);
  38. end;
  39. end;
  40. function SwapPathDelims(const FileName, NewDelim: string): string;
  41. begin
  42. Result := FileName;
  43. Result := StringReplace(Result, '\', NewDelim, [rfReplaceAll]);
  44. Result := StringReplace(Result, '/', NewDelim, [rfReplaceAll]);
  45. end;
  46. function GetDataDir: string;
  47. begin
  48. Result := GetAppDir + PathDelim + SDataDir;
  49. if not DirectoryExists(Result) then
  50. Result := ExtractFileDir(GetAppDir) + PathDelim + SDataDir;
  51. if not DirectoryExists(Result) then
  52. Result := ExtractFileDir(ExtractFileDir(GetAppDir)) + PathDelim + SDataDir;
  53. end;
  54. function GetRootDir: string;
  55. begin
  56. Result := ExtractFileDir(GetAppDir);
  57. if not DirectoryExists(Result + PathDelim + 'Source') then
  58. begin
  59. Result := ExtractFileDir(Result);
  60. if not DirectoryExists(Result + PathDelim + 'Source') then
  61. begin
  62. Result := ExtractFileDir(Result);
  63. if not DirectoryExists(Result + PathDelim + 'Source') then
  64. begin
  65. Result := ExtractFileDir(Result);
  66. if not DirectoryExists(Result + PathDelim + 'Source') then
  67. Result := ExtractFileDir(Result);
  68. end;
  69. end;
  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.