-
Notifications
You must be signed in to change notification settings - Fork 14
/
rpdeltwainfunc.pas
248 lines (229 loc) · 5.84 KB
/
rpdeltwainfunc.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
unit rpdeltwainfunc;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls,rpdeltwain,rptwain,rpmdconsts,jpeg,rpGIFImage,rpgraphutilsvcl;
const MAX_IMAGE_SIZE_KBYTES=1024*100;
type
TFTwainHelp = class(TForm)
BCancel: TButton;
LWait: TLabel;
procedure BCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
apptitle:String;
oldidle:TIdleEvent;
bitmap:TBitmap;
atwain:TDelphiTwain;
procedure OnTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure OnTwainCancel(Sender: TObject;const index:integer);
procedure AppIdle(Sender:TObject;var done:BOolean);
public
{ Public declarations }
end;
function GetBitmapFromTwain(apptitle:String):TBitmap;
function GetBitmapFromTwainMax(apptitle:String;kbytesmax:integer):TBitmap;
function GetJpegImageFromTwainMax(apptitle:String;quality:integer;kbytesmax:integer):TJPegImage;
function GetGifImageFromTwainMax(apptitle:String;colorreduction,dither:integer;kbytesmax:integer):TGifImage;
implementation
{$R *.dfm}
procedure TFTwainHelp.AppIdle(Sender:TObject;var done:BOolean);
var
SourceIndex: Integer;
Source: TTwainSource;
apptit:TW_STR32;
begin
Application.OnIdle:=oldidle;
done:=false;
try
//Make sure that the library and Source Manager
//are loaded
StrPCopy(Pchar(@apptit[0]),Copy(apptitle,1,31));
atwain.AppIdentity.ProductName:=apptit;
aTwain.LibraryLoaded := TRUE;
aTwain.SourceManagerLoaded := TRUE;
//SelectSource method displays a common Twain dialog
//to allow the user to select one of the avaliable
//sources and returns it's index or -1 if either
//the user pressed Cancel or if there were no sources
if atwain.SourceCount<2 then
begin
SourceIndex:=0;
if atwain.SourceCount<1 then
Raise Exception.Create(SRpNoTwain);
end
else
SourceIndex := aTwain.SelectSource();
if (SourceIndex <> -1) then
begin
//Now that we know the index of the source, we'll
//get the object for this source
Source := aTwain.Source[SourceIndex];
//Load source and acquire image
Source.Loaded := TRUE;
Source.Enabled := TRUE;
end
else
Close; {if (SourceIndex <> -1)}
except
On E:Exception do
begin
RpMessageBox(E.Message);
Close;
end;
end;
end;
function GetBitmapFromTwainMax(apptitle:String;kbytesmax:integer):TBitmap;
var
memstream:TMemoryStream;
asize:integer;
begin
if kbytesmax=0 then
kbytesmax:=MAX_IMAGE_SIZE_KBYTES;
Result:=GetBitmapFromTwain(apptitle);
if Assigned(Result) then
begin
memstream:=TMemoryStream.Create;
try
Result.SaveToStream(memstream);
asize:=memstream.size div 1024;
if asize>kbytesmax then
begin
Raise Exception.Create(SRpWaitTwainExceededMax+FormatFloat('##,##',asize)+
','+FormatFloat('##,##',kbytesmax));
end;
finally
memstream.free;
end;
end;
end;
function GetJpegImageFromTwainMax(apptitle:String;quality:integer;kbytesmax:integer):TJPegImage;
var
memstream:TMemoryStream;
asize:integer;
ajpeg:TJPEGImage;
abitmap:TBitmap;
begin
if kbytesmax=0 then
kbytesmax:=MAX_IMAGE_SIZE_KBYTES;
ajpeg:=nil;
abitmap:=GetBitmapFromTwain(apptitle);
if Assigned(abitmap) then
begin
try
ajpeg:=TJPEGImage.Create;
try
memstream:=TMemoryStream.Create;
try
ajpeg.CompressionQuality:=quality;
ajpeg.Assign(abitmap);
ajpeg.SaveToStream(memstream);
asize:=memstream.size div 1024;
if asize>kbytesmax then
begin
Raise Exception.Create(SRpWaitTwainExceededMax+FormatFloat('##,##',asize)+
','+FormatFloat('##,##',kbytesmax));
end;
finally
memstream.free;
end;
except
ajpeg.free;
ajpeg:=nil;
raise;
end;
finally
abitmap.free;
end;
end;
Result:=ajpeg;
end;
function GetGifImageFromTwainMax(apptitle:String;colorreduction,dither:integer;kbytesmax:integer):TGifImage;
var
memstream:TMemoryStream;
asize:integer;
agif:TGifImage;
abitmap:TBitmap;
begin
if kbytesmax=0 then
kbytesmax:=MAX_IMAGE_SIZE_KBYTES;
agif:=nil;
abitmap:=GetBitmapFromTwain(apptitle);
if Assigned(abitmap) then
begin
try
agif:=TGifImage.Create;
try
memstream:=TMemoryStream.Create;
try
agif.ColorReduction:=TColorReduction(colorreduction);
agif.DitherMode:=TDitherMode(dither);
agif.Assign(abitmap);
agif.SaveToStream(memstream);
asize:=memstream.size div 1024;
if asize>kbytesmax then
begin
Raise Exception.Create(SRpWaitTwainExceededMax+FormatFloat('##,##',asize)+
','+FormatFloat('##,##',kbytesmax));
end;
finally
memstream.free;
end;
except
agif.free;
agif:=nil;
raise;
end;
finally
abitmap.free;
end;
end;
Result:=agif;
end;
function GetBitmapFromTwain(apptitle:String):TBitmap;
var
dia: TFTwainHelp;
begin
dia:=TFTwainHelp.Create(Application);
try
dia.oldidle:=Application.OnIdle;
dia.apptitle:=apptitle;
Application.OnIdle:=dia.AppIdle;
dia.ShowModal;
Result:=dia.bitmap;
finally
dia.free;
end;
end;
procedure TFTwainHelp.BCancelClick(Sender: TObject);
begin
bitmap.free;
bitmap:=nil;
Close;
end;
procedure TFTwainHelp.FormCreate(Sender: TObject);
begin
BCancel.Caption:=SRpCancel;
LWait.Caption:=SRpWaitTwain;
atwain:=TDelphiTwain.Create(Self);
atwain.OnAcquireCancel:=OnTwainCancel;
atwain.OnTwainAcquire:=OnTwainAcquire;
end;
procedure TFTwainHelp.OnTwainCancel(Sender: TObject;const index:integer);
begin
bitmap.free;
bitmap:=nil;
Close;
end;
procedure TFTwainHelp.OnTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
//Copies the acquired bitmap to the TImage control
bitmap:=TBitmap.Create;
bitmap.Assign(Image);
//Because the component supports multiple images
//from the source device, Cancel will tell the
//source that we don't want no more images
Cancel := TRUE;
Close;
end;
end.