-
Notifications
You must be signed in to change notification settings - Fork 2
/
AnalyzerPlugins.pas
303 lines (265 loc) · 9.38 KB
/
AnalyzerPlugins.pas
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
///////////////////////////////////////////////////////////////////////////////////////////////
//
// AnalyzerPlugins.pas - Base unit for creating image processing plugins for Image Analyzer
// ----------------------------------------------------------------------------------------
// Version: 2005-06-21
// Maintain: Michael Vinther | mv@logicnet·dk
//
// Last changes:
//
unit AnalyzerPlugins;
interface
uses Windows, SysUtils, Graphics, Classes;
type
TBGRPalette = packed array[0..255] of packed record
B, G, R : Byte;
end;
PBGRPalette = ^TBGRPalette;
TImageContainer = packed record
Width, Height : Integer;
BytesPerLine : Integer;
PixelFormat : Integer; // $00 // Map is a pointer to a zero-terminated string
// $01 // 8 bit. If Palette is NULL when using this format, grayscale is assumed
// $21 // 16 bit grayscale
// $03 // 24 bit color. Image Analyzer will always give 24 bit images in this format
// $04 // 32 bit color.
// $13 // 24 bit, non-interleaved
// $18 // Real matrix each pixel is a double
// $28 // Complex matrix, two doubles per pixel: Re,Im
Map : PByteArray;
Palette : PBGRPalette;
Options : PChar;
end;
PImageContainer = ^TImageContainer;
// Add item to program main menu
const cmdMakeMenuItem = 1;
type TMakeMenuItem = packed record // This command can only be issued from RegisterPlugin
Menu : PChar;
Caption : PChar;
Hint : PChar;
Tag : Integer; // For identification in ProcessImage
end;
PMakeMenuItem = ^TMakeMenuItem;
// Create new image window
const cmdCreateImageWindow = 2;
type TCreateImageWindow = packed record
Name : PChar;
Image : TImageContainer;
end;
PCreateImageWindow = ^TCreateImageWindow;
// Get image from image window
const cmdGetImageWindow = 3;
type TGetImageWindow = packed record
WindowNumber : Integer;
// Set by Analyzer:
TotalWindowCount : Integer;
Name : PChar;
Image : TImageContainer;
Selection : TRect;
end;
PGetImageWindow = ^TGetImageWindow;
// Get handle of main window (this may change when the program is running)
const cmdGetMainWindowHandle = 4;
type TGetMainWindowHandle = packed record
Handle : THandle;
end;
PGetMainWindowHandle = ^TGetMainWindowHandle;
// Update progress and refresh screen
const cmdUpdateProgress = 5;
type TUpdateProgress = packed record
Progress : Integer;
end;
PUpdateProgress = ^TUpdateProgress;
// Get program version
const cmdGetProgramVersion = 6;
type TGetProgramVersion = packed record
Version : Integer;
end;
// Set file open capability
const cmdSetFileOpenCapability = 7;
type TSetFileOpenCapability = packed record // This command can only be issued from RegisterPlugin
Filter : PChar; // File format filter, e.g. '3D models (*.ply;*.3ds)|*.ply;*.3ds'
Tag : Integer; // For identification in ProcessImage. Image.Map will point to file name
end;
PSetFileOpenCapability = ^TSetFileOpenCapability;
// Open file
const cmdOpenFile = 8;
type TOpenFile = packed record
FileName : PChar;
end;
// Refresh children
const cmdRefreshChildren = 9;
type
// Function for sending cmdXXX commands to Image Analyzer
// TAnalyzerCallback function should return 0 on failure
TAnalyzerCallback = function(Command: Integer; Data: Pointer): LongBool; stdcall;
// RegisterPlugin function should return 0 on failure
TRegisterPlugin = function(CallBack: TAnalyzerCallback): LongBool; stdcall;
// Return codes:
// 0 : Ok, image updated
// 1 : Image unassigned/not changed
// 2 : Unable to open file
// 3 : Encoding/decoding error
// 4 : Unsupported pixel format
// 5 : Unable to close file (?)
// 6 : Operation not supported
TProcessImage = function(Tag: Integer; Image: PImageContainer): Integer; stdcall;
var
AnalyzerCallback : TAnalyzerCallback = nil;
procedure RaisePluginError(Result: Integer; Default: string='');
procedure BitmapFromImageContainer(Bitmap: TBitmap; const Image: TImageContainer);
procedure BitmapToImageContainer(Bitmap: TBitmap; out Image: TImageContainer);
procedure FreeImageContainer(var Image: TImageContainer);
function FindImageWindowName(const Image: TImageContainer): string;
function FindImageWindowSelection(const Image: TImageContainer): TRect;
function FindImageWindowMaskSelection(const Image: TImageContainer): Pointer;
procedure RefreshChildren;
implementation
resourcestring
rsUnableToOpenFile = 'Unable to open file';
rsErrorInBitmapData = 'Error in bitmap data';
rsUnsupportedPixelFormat = 'Unsupported pixel format';
rsUnableToCloseFile = 'Unable to close file';
rsProcessFailedD = 'Process failed: %d';
procedure RaisePluginError(Result: Integer; Default: string);
begin
if Result<>0 then
begin
case Result of
2 : raise Exception.Create(rsUnableToOpenFile);
3 : raise Exception.Create(rsErrorInBitmapData);
4 : raise Exception.Create(rsUnsupportedPixelFormat);
5 : raise Exception.Create(rsUnableToCloseFile);
else
begin
if Default='' then Default:=rsProcessFailedD;
raise Exception.CreateFmt(Default,[Result]);
end;
end;
end;
end;
procedure BitmapFromImageContainer(Bitmap: TBitmap; const Image: TImageContainer);
type TPalEntries = array[0..255] of TPaletteEntry;
procedure MakeLogPalette(const Pal: TBGRPalette; var PalEntries; ColorCount: Integer = 256);
var F : Integer;
begin
for F:=0 to ColorCount-1 do with TPalEntries(PalEntries)[F] do
begin
peRed:=Pal[F].R; peGreen:=Pal[F].G; peBlue:=Pal[F].B;
peFlags:=PC_RESERVED;
end;
end;
function MakeHPalette(const Pal: TBGRPalette; ColorCount: Integer = 256): HPALETTE;
var LogPal: PLogPalette; // LogPalette
begin
GetMem(LogPal,SizeOf(TLogPalette)+SizeOf(TPaletteEntry)*255);
try
LogPal^.PalVersion:=$300;
LogPal^.PalNumEntries:=ColorCount;
MakeLogPalette(Pal,LogPal^.palPalEntry,ColorCount);
MakeHPalette:=CreatePalette(LogPal^);
finally
FreeMem(LogPal);
end;
end;
var
Y : Integer;
GrayPal : TBGRPalette;
begin
Bitmap.Width:=0;
case Image.PixelFormat of
$01 : Bitmap.PixelFormat:=pf8bit;
$03 : Bitmap.PixelFormat:=pf24bit;
else raise Exception.Create(rsUnsupportedPixelFormat);
end;
Bitmap.Width:=Image.Width;
Bitmap.Height:=Image.Height;
if Image.PixelFormat=$01 then
begin
if Assigned(Image.Palette) then Bitmap.Palette:=MakeHPalette(Image.Palette^)
else
begin
for Y:=0 to 255 do with GrayPal[Y] do
begin
R:=Y;
G:=Y;
B:=Y;
end;
Bitmap.Palette:=MakeHPalette(GrayPal);
end;
end;
for Y:=0 to Image.Height-1 do Move(Image.Map^[Y*Image.BytesPerLine],Bitmap.ScanLine[Y]^,Image.Width*Image.PixelFormat);
end;
procedure BitmapToImageContainer(Bitmap: TBitmap; out Image: TImageContainer);
var
Y : Integer;
begin
FillChar(Image,SizeOf(Image),0);
case Bitmap.PixelFormat of
pf8bit : Image.PixelFormat:=$01;
pf24bit : Image.PixelFormat:=$03;
else raise Exception.Create(rsUnsupportedPixelFormat);
end;
Image.Width:=Bitmap.Width;
Image.Height:=Bitmap.Height;
Image.BytesPerLine:=Image.Width*Image.PixelFormat;
GetMem(Image.Map,Image.Height*Image.BytesPerLine);
for Y:=0 to Image.Height-1 do Move(Bitmap.ScanLine[Y]^,Image.Map^[Y*Image.BytesPerLine],Image.BytesPerLine);
end;
procedure FreeImageContainer(var Image: TImageContainer);
begin
if Assigned(Image.Map) then FreeMem(Image.Map); Image.Map:=nil;
if Assigned(Image.Palette) then FreeMem(Image.Palette); Image.Palette:=nil;
end;
function FindImageWindowName(const Image: TImageContainer): string;
var
GetImageWindow : TGetImageWindow;
begin
GetImageWindow.WindowNumber:=0;
while AnalyzerCallback(cmdGetImageWindow,@GetImageWindow) do
begin
if GetImageWindow.Image.Map=Image.Map then
begin
Result:=GetImageWindow.Name;
Exit;
end;
Inc(GetImageWindow.WindowNumber);
end;
end;
function FindImageWindowSelection(const Image: TImageContainer): TRect;
var
GetImageWindow : TGetImageWindow;
begin
GetImageWindow.WindowNumber:=0;
while AnalyzerCallback(cmdGetImageWindow,@GetImageWindow) do
begin
if GetImageWindow.Image.Map=Image.Map then
begin
Result:=GetImageWindow.Selection;
Exit;
end;
Inc(GetImageWindow.WindowNumber);
end;
Result:=Rect(-1,-1,-1,-1);
end;
function FindImageWindowMaskSelection(const Image: TImageContainer): Pointer;
var
GetImageWindow : TGetImageWindow;
begin
GetImageWindow.WindowNumber:=0;
while AnalyzerCallback(cmdGetImageWindow,@GetImageWindow) do
begin
if GetImageWindow.Image.Map=Image.Map then
begin
Result:=GetImageWindow.Image.Options;
Exit;
end;
Inc(GetImageWindow.WindowNumber);
end;
Result:=nil;
end;
procedure RefreshChildren;
begin
AnalyzerCallback(cmdRefreshChildren,nil);
end;
end.