📄 imscan.pas
字号:
begin
///// Buffered xfer
LogWrite(' IETW_XferReady : buffered transfer mode');
buffers := nil;
if DelayImageInfo then
buffers := TList.Create;
if assigned(Progress) then
Progress.per1 := 100 / twImageInfo.ImageLength;
if IETW_DS(grec, DG_CONTROL, DAT_SETUPMEMXFER, MSG_GET, @setupmemxfer) then
LogWrite(' IETW_XferReady : DAT_SETUPMEMXFER Ok')
else
LogWrite(' IETW_XferReady : DAT_SETUPMEMXFER FAILED!');
hbuff := GlobalAlloc(GPTR, setupmemxfer.Preferred);
with imxfer do
begin
Compression := TWON_DONTCARE16;
BytesPerRow := TW_UINT32(TWON_DONTCARE32);
Columns := TW_UINT32(TWON_DONTCARE32);
Rows := TW_UINT32(TWON_DONTCARE32);
XOffset := TW_UINT32(TWON_DONTCARE32);
YOffset := TW_UINT32(TWON_DONTCARE32);
BytesWritten := TW_UINT32(TWON_DONTCARE32);
Memory.Length := setupmemxfer.Preferred;
if TWParams.UseMemoryHandle then
begin
Memory.Flags := TWMF_APPOWNS or TWMF_HANDLE;
Memory.TheMem := pointer(hbuff);
end
else
begin
Memory.Flags := TWMF_APPOWNS or TWMF_POINTER;
Memory.TheMem := GlobalLock(hbuff);
end;
end;
repeat
if IETW_DS(grec, DG_IMAGE, DAT_IMAGEMEMXFER, MSG_GET, @imxfer) then
LogWrite(' IETW_XferReady : DAT_IMAGEMEMXFER Ok')
else
LogWrite(' IETW_XferReady : DAT_IMAGEMEMXFER FAILED! (image terminated?)');
case rc of
TWRC_SUCCESS, TWRC_XFERDONE:
begin
if rc = TWRC_SUCCESS then
LogWrite(' IETW_XferReady : TWRC_SUCCESS begin');
if rc = TWRC_XFERDONE then
LogWrite(' IETW_XferReady : TWRC_XFERDONE begin');
if DelayImageInfo then
begin
new(pimxfer);
move(imxfer, pimxfer^, sizeof(TW_IMAGEMEMXFER));
getmem(pimxfer^.Memory.TheMem, imxfer.BytesWritten);
ptr := GlobalLock(integer(imxfer.Memory.TheMem));
copymemory(pimxfer^.Memory.TheMem, ptr, imxfer.BytesWritten);
GlobalUnlock(integer(imxfer.Memory.TheMem));
buffers.Add(pimxfer);
end
else
CopyBuffer(grec, fBitmap, twImageInfo, imxfer, true);
if rc = TWRC_XFERDONE then
begin
// CAP_CAPTION
if not GetOneStringCapability(grec, IOParams.FileName, CAP_CAPTION) then
IOParams.FileName := '';
//
nState := 7;
transferdone := true;
if DelayImageInfo then
begin
// get image info and copy buffers
if (nState = 7) and IETW_DS(grec, DG_CONTROL, DAT_PENDINGXFERS, MSG_ENDXFER, @pendingXfers) then
begin
if pendingXfers.Count <> 0 then
nState := 6
else
nState := 5;
end;
if ImageInfo then
begin
for i := 0 to buffers.Count - 1 do
begin
pimxfer := buffers[i];
CopyBuffer(grec, fBitmap, twImageInfo, pimxfer^, false);
end;
end;
DelayImageInfo := true; // this because ImageInfo set it to False
end;
//
break;
end;
LogWrite(' IETW_XferReady : TWRC_SUCCESS or TWRC_XFERDONE end');
end;
TWRC_CANCEL:
begin
LogWrite(' IETW_XferReady : TWRC_CANCEL');
breakmodalloop := true;
nState := 7;
if bHideUI then
fAborting := true;
break;
end;
TWRC_FAILURE:
begin
LogWrite(' IETW_XferReady : TWRC_FAILURE');
nState := 6;
if bHideUI then
fAborting := true;
break;
end;
end;
// OnProgress
if assigned(Progress) then
begin
with Progress^ do
if assigned(fOnProgress) then
fOnProgress(Sender, trunc(per1 * (imxfer.YOffset + imxfer.Rows)));
if Progress^.Aborting^ then
begin
nState := 7;
if bHideUI then
fAborting := true;
break;
end;
end;
until false;
if not TWParams.UseMemoryHandle then
GlobalUnlock(hbuff);
GlobalFree(hbuff);
if DelayImageInfo then
begin
while buffers.Count > 0 do
begin
pimxfer := buffers[0];
freemem(pimxfer^.Memory.TheMem);
dispose(pimxfer);
buffers.delete(0);
end;
FreeAndNil(buffers);
end;
end;
tmNative:
begin
////// Native xfer
LogWrite(' IETW_XferReady : Native transfer mode');
IETW_DS(grec, DG_IMAGE, DAT_IMAGENATIVEXFER, MSG_GET, @hNative);
case (rc) of
TWRC_XFERDONE:
begin
// copy image
LogWrite(' IETW_XferReady : TWRC_XFERDONE');
_CopyDIB2BitmapEx(hNative, fBitmap, nil, false);
GlobalFree(hNative); // 2.0.9
//
nState := 7;
transferdone := true;
end;
TWRC_CANCEL:
begin
LogWrite(' IETW_XferReady : TWRC_CANCEL');
breakmodalloop := true;
nState := 7;
if bHideUI then
fAborting := true;
end;
TWRC_FAILURE:
begin
LogWrite(' IETW_XferReady : TWRC_FAILURE');
nState := 6;
if bHideUI then
fAborting := true;
end;
else
nState := 6;
end;
end;
tmFile:
begin
////// File xfer
LogWrite(' IETW_XferReady : File transfer mode');
IETW_DS(grec, DG_CONTROL, DAT_SETUPFILEXFER, MSG_GET, @setupfilexfer);
settemppath(@setupfilexfer.FileName[0]);
if (setupfilexfer.Format = 1) or (setupfilexfer.Format = 3) or (setupfilexfer.Format = 5) or (setupfilexfer.Format = 6) or (setupfilexfer.Format > 7) then
setupfilexfer.Format := TWFF_BMP;
setupfilexfer.VRefNum := 0;
IETW_DS(grec, DG_CONTROL, DAT_SETUPFILEXFER, MSG_SET, @setupfilexfer);
IETW_DS(grec, DG_IMAGE, DAT_IMAGEFILEXFER, MSG_GET, nil);
case (rc) of
TWRC_XFERDONE:
begin
// copy image
LogWrite(' IETW_XferReady : TWRC_XFERDONE');
io := TImageEnIO.Create(nil);
io.AttachedIEBitmap := fBitmap;
io.LoadFromFileFormat(setupfilexfer.FileName, FindFileFormat(setupfilexfer.FileName, false));
FreeAndNil(io);
DeleteFile( setupfilexfer.FileName );
//
nState := 7;
transferdone := true;
end;
TWRC_CANCEL:
begin
LogWrite(' IETW_XferReady : TWRC_CANCEL');
breakmodalloop := true;
nState := 7;
if bHideUI then
fAborting := true;
end;
TWRC_FAILURE:
begin
LogWrite(' IETW_XferReady : TWRC_FAILURE');
nState := 6;
if bHideUI then
fAborting := true;
end;
else
nState := 6;
end;
end;
end;
breakmodalloop := true;
IETW_AbortAllPendingXfers(grec);
end;
LogWrite(' IETW_XferReady : end');
{$WARNINGS ON}
end;
///////////////////////////////////////////////////////////////////////////////////////
procedure IETW_XferReadyMulti(var grec: tgrec; pmsg: PMSG);
var
hNative: TW_UINT32;
setupmemxfer: TW_SETUPMEMXFER;
setupfilexfer: TW_SETUPFILEXFER;
imxfer: TW_IMAGEMEMXFER;
hbuff: THandle;
twImageInfo: TW_IMAGEINFO;
ofy: integer;
ofy_set: boolean;
pimxfer: pTW_IMAGEMEMXFER;
DelayImageInfo: boolean; // if true recall ImageInfo after loaded all buffers
buffers: TList;
ptr: pointer;
i: integer;
fCaption: string;
io: TImageEnIO;
pixfor:TIEPixelFormat;
//
function ImageInfo: boolean;
begin
LogWrite('IETW_XferReadyMulti.ImageInfo');
DelayImageInfo := false;
result := true;
try
with grec do
begin
if not IETW_DS(grec, DG_IMAGE, DAT_IMAGEINFO, MSG_GET, TW_MEMREF(@twImageInfo)) then
begin
IETW_AbortAllPendingXfers(grec);
result := false;
LogWrite('IETW_XferReadyMulti.ImageInfo : not available!');
exit;
end;
if (TransferMode <> tmFile) and ((twImageInfo.PixelType > 2) or (twImageInfo.Planar <> false) or (twImageInfo.Compression <> 0)) then
TransferMode := tmNative;
if (twImageInfo.ImageWidth < 0) or (twImageInfo.ImageLength < 0) then
begin
DelayImageInfo := true;
result := true;
exit;
end;
if (twImageInfo.ImageWidth <= 0) or (twImageInfo.ImageLength <= 0) then
begin
IETW_AbortAllPendingXfers(grec);
result := false;
exit;
end;
fBitmap := TIEBitmap.Create;
if NativePixelFormat then
begin
case twImageInfo.BitsPerPixel of
1: pixfor:=ie1g;
8: pixfor:=ie8g;
16: pixfor:=ie16g;
24: pixfor:=ie24RGB;
48: pixfor:=ie48RGB;
end;
end
else
begin
if twImageInfo.BitsPerPixel = 1 then
pixfor:=ie1g
else
pixfor:=ie24RGB;
end;
fBitmap.Allocate(twImageInfo.ImageWidth, twImageInfo.ImageLength, pixfor)
end;
except
LogWrite(' IETW_XferReadyMulti.ImageInfo : exception!');
if result then
begin
IETW_AbortAllPendingXfers(grec);
result := false;
end;
end;
LogWrite(' IETW_XferReadyMulti.ImageInfo : end');
end;
//
begin
{$WARNINGS OFF}
LogWrite('IETW_XferReadyMulti');
fCaption := '';
with grec do
begin
repeat
LogWrite(' IETW_XferReadyMulti : getting another image');
if assigned(Progress) and Progress^.Aborting^ then
begin
IETW_AbortAllPendingXfers(grec);
exit;
end;
if not ImageInfo then
begin
LogWrite('IETW_XferReadyMulti : ABORTED, image info not available!');
fAborting := true;
exit;
end;
//DelayImageInfo:=true; // uncomment for force undefined size (test only)
case TransferMode of
tmBuffered:
begin
///// Buffered xfer
LogWrite(' IETW_XferReadyMulti : buffered transfer mode');
buffers := nil;
if DelayImageInfo then
buffers := TList.Create;
if IETW_DS(grec, DG_CONTROL, DAT_SETUPMEMXFER, MSG_GET, @setupmemxfer) then
LogWrite(' IETW_XferReadyMulti : DAT_SETUPMEMXFER Ok')
else
LogWrite(' IETW_XferReadyMulti : DAT_SETUPMEMXFER FAILED!');
hbuff := GlobalAlloc(GPTR, setupmemxfer.Preferred);
with imxfer do
begin
Compression := TWON_DONTCARE16;
BytesPerRow := TW_UINT32(TWON_DONTCARE32);
Columns := TW_UINT32(TWON_DONTCARE32);
Rows := TW_UINT32(TWON_DONTCARE32);
XOffset := TW_UINT32(TWON_DONTCARE32);
YOffset := TW_UINT32(TWON_DONTCARE32);
BytesWritten := TW_UINT32(TWON_DONTCARE32);
Memory.Length := setupmemxfer.Preferred;
if TWParams.UseMemoryHandle then
begin
Memory.Flags := TWMF_APPOWNS or TWMF_HANDLE;
Memory.TheMem := pointer(hbuff);
end
else
begin
Memory.Flags := TWMF_APPOWNS or TWMF_POINTER;
Memory.TheMem := GlobalLock(hbuff);
end;
end;
if assigned(Progress) then
Progress.per1 := 100 / twImageInfo.ImageLength;
ofy_set := false;
ofy := 0;
repeat
if IETW_DS(grec, DG_IMAGE, DAT_IMAGEMEMXFER, MSG_GET, @imxfer) then
LogWrite(' IETW_XferReadyMulti : DAT_IMAGEMEMXFER Ok')
else
LogWrite(' IETW_XferReadyMulti : DAT_IMAGEMEMXFER FAILED! (image terminated?)');
if not ofy_set then
begin
ofy_set := true;
ofy := imxfer.YOffset;
end;
imxfer.YOffset := imxfer.YOffset - ofy;
case rc of
TWRC_SUCCESS, TWRC_XFERDONE:
begin
if rc = TWRC_SUCCESS then
LogWrite(' IETW_XferReadyMulti : TWRC_SUCCESS begin');
if rc = TWRC_XFERDONE then
LogWrite(' IETW_XferReadyMulti : TWRC_XFERDONE begin');
if DelayImageInfo then
begin
new(pimxfer);
move(imxfer, pimxfer^, sizeof(TW_IMAGEMEMXFER));
getmem(pimxfer^.Memory.TheMem, imxfer.BytesWritten);
ptr := GlobalLock(integer(imxfer.Memory.TheMem));
copymemory(pimxfer^.Memory.TheMem, ptr, imxfer.BytesWritten);
GlobalUnlock(integer(imxfer.Memory.TheMem));
buffers.Add(pimxfer);
end
else
CopyBuffer(grec, fBitmap, twImageInfo, imxfer, true);
if rc = TWRC_XFERDONE then
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -