1 unit FreeUtils;
2
3 // ==========================================================
4 //
5 // Delphi wrapper for FreeImage 3
6 //
7 // Design and implementation by
8 // - Anatoliy Pulyaevskiy (xvel84@rambler.ru)
9 //
10 // Contributors:
11 // - Enzo Costantini (enzocostantini@libero.it)
12 // - Armindo (tech1.yxendis@wanadoo.fr)
13 // - Lorenzo Monti (LM) lomo74@gmail.com
14 //
15 // Revision history
16 // When Who What
17 // ----------- ----- -----------------------------------------------------------
18 // 2010-07-14 LM made RAD2010 compliant (unicode)
19 //
20 // This file is part of FreeImage 3
21 //
22 // COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
23 // OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES
24 // THAT THE COVERED CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE
25 // OR NON-INFRINGING. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED
26 // CODE IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT
27 // THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY
28 // SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL
29 // PART OF THIS LICENSE. NO USE OF ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER
30 // THIS DISCLAIMER.
31 //
32 // Use at your own risk!
33 //
34 // ==========================================================
35
36 interface
37
38 {$I 'Version.inc'}
39
40 uses
41 {$IFDEF DELPHI2010}AnsiStrings,{$ENDIF} SysUtils, Classes, FreeImage;
42
FIU_GetFIFTypenull43 function FIU_GetFIFType(filename: AnsiString): FREE_IMAGE_FORMAT;
44
45 // returns FIF (plugin) description string
FIU_GetFIFDescriptionnull46 function FIU_GetFIFDescription(fif: FREE_IMAGE_FORMAT): AnsiString;
47
48 procedure FIU_GetAllDescriptions(var Descriptions: TStringList);
49
50 // returns file extentions for FIF (e.g. '*.tif;*.tiff)
51 function FIU_GetFIFExtList(fif: FREE_IMAGE_FORMAT): AnsiString;
52
53 // returns file extentions for all plugins
54 function FIU_GetFullExtList: AnsiString;
55
56 // returns "Description + | + ExtList" for specified FIF
57 function FIU_GetFIFFilter(fif: FREE_IMAGE_FORMAT): AnsiString;
58
59 // All supported formats + Full filter list for FIFs
60 function FIU_GetAllFilters: AnsiString;
61
62 //Filter for OpenDialogs
63 function FIU_GetAllOpenFilters: AnsiString;
64
65 //Filter for SaveDialogs
66 function FIU_GetAllSaveFilters: AnsiString;
67
68 implementation
69
70 const
71 FIF_START = FIF_UNKNOWN;
72 FIF_END = FIF_XPM;
73
74 function FIU_GetFIFType(filename: AnsiString): FREE_IMAGE_FORMAT;
75 begin
76 Result := FreeImage_GetFileType(PAnsiChar(filename), 0);
77 end;
78
79 function FIU_GetFIFDescription(fif: FREE_IMAGE_FORMAT): AnsiString;
80 begin
81 Result := FreeImage_GetFIFDescription(fif)
82 end;
83
84 procedure FIU_GetAllDescriptions(var Descriptions: TStringList);
85 var
86 fif: FREE_IMAGE_FORMAT;
87 begin
88 Descriptions.Clear;
89 for fif := FIF_START to FIF_END do
90 Descriptions.Add(string(FreeImage_GetFIFDescription(fif)) + ' (' +
91 string(FIu_GetFIFExtList(fif)) + ')');
92 end;
93
94 function FIU_GetFIFExtList(fif: FREE_IMAGE_FORMAT): AnsiString;
95 var
96 ExtList: AnsiString;
97 I: Smallint;
98 C: AnsiChar;
99 begin
100 Result := '*.';
101 ExtList := FreeImage_GetFIFExtensionList(fif);
102 for I := 1 to Length(ExtList) do
103 begin
104 C := ExtList[i];
105 if C <> ',' then
106 Result := Result + C
107 else
108 Result := Result + ';*.';
109 end
110 end;
111
112 function FIU_GetFullExtList: AnsiString;
113 var
114 fif: FREE_IMAGE_FORMAT;
115 begin
116 Result := FIU_GetFIFExtList(FIF_START);
117 for fif := FIF_START to FIF_END do
118 Result := Result + ';' + FIU_GetFIFExtList(fif)
119 end;
120
121 function FIU_GetFIFFilter(fif: FREE_IMAGE_FORMAT): AnsiString;
122 var
123 Text, ExtList: AnsiString;
124 begin
125 Result := '';
126 if fif <> FIF_UNKNOWN then
127 begin
128 Text := {$IFDEF DELPHI2010}AnsiStrings.{$ENDIF}Trim(FreeImage_GetFIFDescription(fif));
129 ExtList := FIU_GetFIFExtList(fif);
130 Result := Text + '(' + ExtList + ')' + '|' + ExtList
131 end
132 end;
133
134 function FIU_GetAllFilters: AnsiString;
135 var
136 fif: FREE_IMAGE_FORMAT;
137 begin
138 Result := 'All supported formats|' + FIU_GetFullExtList;
139 for fif := FIF_START to FIF_END do
140 begin
141 Result := Result + '|' + FIU_GetFIFFilter(fif)
142 end;
143 end;
144
145 function FIU_GetAllOpenFilters: AnsiString;
146 var
147 fif: FREE_IMAGE_FORMAT;
148 begin
149 Result := 'All supported formats|' + FIU_GetFullExtList;
150 for fif := FIF_START to FIF_END do
151 if FreeImage_FIFSupportsReading(fif) then
152 begin
153 Result := Result + '|' + FIU_GetFIFFilter(fif)
154 end;
155 end;
156
157 function FIU_GetAllSaveFilters: AnsiString;
158 var
159 ExtList: AnsiString;
160 I: Smallint;
161 C: AnsiChar;
162 fif: FREE_IMAGE_FORMAT;
163 s: AnsiString;
164 begin
165 result := '';
166 for fif := FIF_START to FIF_END do
167 if FreeImage_FIFSupportsWriting(fif) then
168 begin
169 ExtList := FreeImage_GetFIFExtensionList(fif);
170 s := '';
171 for I := 1 to Length(ExtList) do
172 begin
173 C := ExtList[i];
174 if C <> ',' then
175 S := S + C
176 else
177 begin
178 result := Result + FreeImage_GetFIFDescription(fif) + ' (' + UpperCase(s) + ')|*.' + s + '|';
179 s := '';
180 end;
181 end;
182 result := Result + FreeImage_GetFIFDescription(fif) + ' (' + UpperCase(s) + ')|*.' + s + '|';
183 end;
184 end;
185
186 end.
187