1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
unit FreeUtils;
// ==========================================================
//
// Delphi wrapper for FreeImage 3
//
// Design and implementation by
// - Anatoliy Pulyaevskiy (xvel84@rambler.ru)
//
// Contributors:
// - Enzo Costantini (enzocostantini@libero.it)
//
// This file is part of FreeImage 3
//
// COVERED CODE IS PROVIDED UNDER THIS LICENSE ON AN "AS IS" BASIS, WITHOUT WARRANTY
// OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, WITHOUT LIMITATION, WARRANTIES
// THAT THE COVERED CODE IS FREE OF DEFECTS, MERCHANTABLE, FIT FOR A PARTICULAR PURPOSE
// OR NON-INFRINGING. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE COVERED
// CODE IS WITH YOU. SHOULD ANY COVERED CODE PROVE DEFECTIVE IN ANY RESPECT, YOU (NOT
// THE INITIAL DEVELOPER OR ANY OTHER CONTRIBUTOR) ASSUME THE COST OF ANY NECESSARY
// SERVICING, REPAIR OR CORRECTION. THIS DISCLAIMER OF WARRANTY CONSTITUTES AN ESSENTIAL
// PART OF THIS LICENSE. NO USE OF ANY COVERED CODE IS AUTHORIZED HEREUNDER EXCEPT UNDER
// THIS DISCLAIMER.
//
// Use at your own risk!
//
// ==========================================================
interface
uses
SysUtils, Classes, FreeImage;
function FIU_GetFIFType(filename: string): FREE_IMAGE_FORMAT;
// returns FIF (plugin) description string
function FIU_GetFIFDescription(fif: FREE_IMAGE_FORMAT): string;
procedure FIU_GetAllDescriptions(var Descriptions: TStringList);
// returns file extentions for FIF (e.g. '*.tif;*.tiff)
function FIU_GetFIFExtList(fif: FREE_IMAGE_FORMAT): string;
// returns file extentions for all plugins
function FIU_GetFullExtList: string;
// returns "Description + | + ExtList" for specified FIF
function FIU_GetFIFFilter(fif: FREE_IMAGE_FORMAT): string;
// All supported formats + Full filter list for FIFs + All files
function FIU_GetAllFilters: string;
implementation
uses StrUtils;
function FIU_GetFIFType(filename: string): FREE_IMAGE_FORMAT;
begin
Result:=FreeImage_GetFileType(PAnsiChar(filename),0);
end;
function FIU_GetFIFDescription(fif: FREE_IMAGE_FORMAT): string;
begin
Result := FreeImage_GetFIFDescription(fif)
end;
procedure FIU_GetAllDescriptions(var Descriptions: TStringList);
var
fif: FREE_IMAGE_FORMAT;
begin
Descriptions.Clear;
for fif := FIF_BMP to FIF_XPM do
Descriptions.Add(FreeImage_GetFIFDescription(fif) + ' (' + FIu_GetFIFExtList(fif) + ')')
end;
function FIU_GetFIFExtList(fif: FREE_IMAGE_FORMAT): string;
var
ExtList: string;
I: Smallint;
C: Char;
begin
Result := '*.';
ExtList := FreeImage_GetFIFExtensionList(fif);
for I := 1 to Length(ExtList) do
begin
C := ExtList[i];
if C <> ',' then
Result := Result + C
else
Result := Result + ';*.';
end
end;
function FIU_GetFullExtList: string;
var
fif: FREE_IMAGE_FORMAT;
begin
Result := FIU_GetFIFExtList(FIF_BMP);
for fif := FIF_ICO to FIF_XPM do
Result := Result + ';' + FIU_GetFIFExtList(fif)
end;
function FIU_GetFIFFilter(fif: FREE_IMAGE_FORMAT): string;
var
Text, ExtList: string;
begin
Result := '';
if fif <> FIF_UNKNOWN then
begin
Text := Trim(FreeImage_GetFIFDescription(fif));
ExtList := FIU_GetFIFExtList(fif);
Result := Text + '(' + ExtList + ')' + '|' + ExtList
end
end;
function FIU_GetAllFilters: string;
var
fif: FREE_IMAGE_FORMAT;
begin
Result := 'All supported formats|' + FIU_GetFullExtList;
for fif := FIF_BMP to FIF_XPM do
begin
Result := Result + '|' + FIU_GetFIFFilter(fif)
end;
end;
end.
|
