imscan.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

(*
Copyright (c) 1998-2007 by HiComponents. All rights reserved.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

HiComponents grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial,
shareware or freeware libraries or components.

email: [e-mail]

http://www.hicomponents.com
*)

unit imscan;

{$R-}
{$Q-}

{$I ie.inc}

{$IFDEF IEINCLUDETWAIN}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ImageEnIO, ietwain, hyiedefs, hyieutils;

type
  TIETWCloseCallBack = procedure of object;

function IETW_SelectImageSource(var SelectedSourceName: string; TWainShared: PIETWainShared; callwnd: HWND): boolean;
function IETW_Acquire(Bitmap: TIEBitmap; multi: boolean; MultiCallBack: TIEMultiCallBack; Params: TIETWainParams; IOParams: TIOParamsVals; var Progress: TProgressRec; TWainShared: PIETWainShared; callwnd: HWND; DoNativePixelFormat:boolean): boolean;
procedure IETW_GetSourceList(SList: TList; TWainShared: PIETWainShared; callwnd: HWND);
function IETW_GetCapabilities(Params: TIETWainParams; var Capabilities: TIETWSourceCaps; setcap: boolean; TWainShared: PIETWainShared; callwnd: HWND): boolean;
function IETW_GetDefaultSource(TWainShared: PIETWainShared; callwnd: HWND): string;
procedure IETW_FreeResources(TWainShared: PIETWainShared; callwnd: HWND);

// new implementation
function IETWAINAcquireOpen(CloseCallBack: TIETWCloseCallBack; MultiCallBack: TIEMultiCallBack; Params: TIETWainParams; TWainShared: PIETWainShared; IOParams: TIOParamsVals; parent: TWinControl; DoNativePixelFormat:boolean): pointer;
procedure IETWAINAcquireClose(var grec: pointer);

implementation

uses ImageEnProc, forms;

{$R-}

type

  ErrorDetail = (
    ED_NONE,
    ED_START_TRIPLET_ERRS,
    ED_CAP_GET, // MSG_GET triplet on a capability failed
    ED_CAP_SET, // MSG_SET triplet on capability failed
    ED_DSM_FAILURE, // TWAIN DSM returned TWRC_FAILURE
    ED_DS_FAILURE, // source returned TWRC_FAILURE
    ED_END_TRIPLET_ERRS,
    ED_NOT_STATE_4, // operation invoked in wrong state
    ED_NULL_HCON, // MSG_GET returned a null container handle
    ED_BAD_HCON, // MSG_GET returned an invalid/unlockable container handle
    ED_BAD_CONTYPE, // returned container ConType is not valid.
    ED_BAD_ITEMTYPE, // returned container ItemType is not valid.
    ED_CAP_GET_EMPTY, // returned container has 0 items.
    ED_CAP_SET_EMPTY // trying to restrict a cap to empty set
    );

  TIEDPI = record
    xdpi: integer;
    ydpi: integer;
  end;
  PIEDPI = ^TIEDPI;

const
  DSM_FILENAME = 'TWAIN_32.DLL';
  DSM_ENTRYPOINT = 'DSM_Entry';

  TWAIN_PRESESSION = 1; // source manager not loaded
  TWAIN_SM_LOADED = 2; // source manager loaded
  TWAIN_SM_OPEN = 3; // source manager open
  TWAIN_SOURCE_OPEN = 4; // source open but not enabled
  TWAIN_SOURCE_ENABLED = 5; // source enabled to acquire
  TWAIN_TRANSFER_READY = 6; // image ready to transfer
  TWAIN_TRANSFERRING = 7; // image in transit

  TWAIN_BW = $0001; // 1-bit per pixel, B&W 	(== TWPT_BW)
  TWAIN_GRAY = $0002; // 1,4, or 8-bit grayscale  (== TWPT_GRAY)
  TWAIN_RGB = $0004; // 24-bit RGB color         (== TWPT_RGB)
  TWAIN_PALETTE = $0008; // 1,4, or 8-bit palette    (== TWPT_PALETTE)
  TWAIN_ANYTYPE = $0000; // any of the above

type

  tgrec = record
    nState: integer; // TWAIN state (per the standard)
    hDSMLib: THANDLE; // handle of DSM
    DSM_Entry: TDSMEntryProc; // entry point of Data Source Manager (TWAIN.DLL)
    hwnd32SM: TW_INT32;
    rc: TW_INT16; // result code
    AppId: TW_IDENTITY;
    SourceId: TW_IDENTITY; // source identity structure
    twUI: TW_USERINTERFACE;
    nErrDetail: ErrorDetail; // detailed error code
    nErrRC, nErrCC: word; // result code and condition code for last error
    bHideUI: boolean; // allow source u/i to be hidden
    pendingXfers: TW_PENDINGXFERS;
    gmulti: boolean;
    MultiCallBack: TIEMultiCallBack;
    fAborting: boolean; // usato solo se bHideUI=true
    TWParams: TIETWainParams;
    IOParams: TIOParamsVals;
    NativePixelFormat:boolean;  // copy of IOParams.IsNativePixelFormat or TImageEnMIO.NativePixelFormat, you should read this value instead of IOParams.IsNativePixelFormat
    TransferMode: (tmNative, tmBuffered, tmFile);
    transferdone: boolean; // true on transfer completed
    breakmodalloop: boolean;
    fBitmap: TIEBitmap; // bitmap to fill
    Progress: PProgressRec;
    PTWainShared: PIETWainShared;
    actwnd: HWND;
    callwnd: HWND;
    BWToInvert: boolean; // the black/white image need to be inverted
    // new implementation
    ProxyWin: TWinControl;
    modal: boolean;
    sending: boolean;
    fclosecallback: TIETWCloseCallBack;
    fWindowList: pointer;
  end;
  pgrec = ^tgrec;

function GetUINT16asInteger(var grec: tgrec; ilist: TIEIntegerList; cap: TW_UINT16): boolean; forward;

procedure IETW_EmptyMessageQueue(var grec: tgrec); forward;

procedure LogWrite(ss: string);
begin
  if iegTWainLogName <> '' then
  begin
    closefile(iegTWainLogFile);
    assignfile(iegTWainLogFile, iegTWainLogName);
    append(iegTWainLogFile);
    WriteLn(iegTWainLogFile, datetostr(date) + ' ' + timetostr(time) + ' : ' + ss);
    Flush(iegTWainLogFile);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure Init_grec(var grec: tgrec);
begin
  grec.actwnd := windows.getactivewindow;
  grec.fAborting := false;
  grec.nState := 1;
  grec.TWParams := nil;
  grec.BWToInvert := false;
  grec.sending := false;
  with grec.AppId do
  begin
    id := 0;
    with version do
    begin
      MajorNum := 1;
      MinorNum := 0;
      Language := TWLG_USA;
      Country := TWCY_USA;
      Info := ' ' + #0;
    end;
    ProtocolMajor := TWON_PROTOCOLMAJOR;
    ProtocolMinor := TWON_PROTOCOLMINOR;
    SupportedGroups := DG_IMAGE or DG_CONTROL;
    Manufacturer := ' ' + #0;
    ProductFamily := ' ' + #0;
    ProductName := ' ' + #0;
  end;
  grec.fWindowList := nil;
  grec.NativePixelFormat:=false;
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure Set_AppId(var grec: tgrec);
begin
  with grec.AppId do
  begin
    strcopy(version.Info, pchar(grec.TWParams.AppVersionInfo)); // <?>
    version.Info[33] := #0;
    strcopy(Manufacturer, pchar(grec.TWParams.AppManufacturer));
    Manufacturer[33] := #0;
    strcopy(ProductFamily, pchar(grec.TWParams.AppProductFamily));
    ProductFamily[33] := #0;
    strcopy(ProductName, pchar(grec.TWParams.AppProductName));
    ProductName[33] := #0;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_LoadSourceManager(var grec: tgrec): boolean;
var
  szSMDir: array[0..255] of char;
  cc: integer;
begin
  with grec do
  begin
    LogWrite('IETW_LoadSourceManager');
    if (nState >= 2) then
    begin
      LogWrite('  IETW_LoadSourceManager : already loaded');
      result := TRUE; // DSM already loaded
      exit;
    end;
    if PTWainShared^.hDSMLib <> 0 then
    begin
      hDSMLib := PTWainShared^.hDSMLib;
      DSM_Entry := PTWainShared^.DSM_Entry;
      result := TRUE;
      nState := 2;
      LogWrite('  IETW_LoadSourceManager : already loaded');
      exit;
    end;
    GetWindowsDirectory(szSMDir, sizeof(szSMDir));
    cc := lstrlen(szSMDir);
    if (cc <> 0) and (szSMDir[cc - 1] <> ':') then
      lstrcat(szSMDir, '\');
    lstrcat(szSMDir, DSM_FILENAME);
    if fileexists(string(szSMDir)) then
    begin
      hDSMLib := LoadLibrary(szSMDir);
    end
    else
    begin
      hDSMLib := 0;
    end;
    if hDSMLib <> 0 then
    begin
      LogWrite('  IETW_LoadSourceManager : Load OK');
      DSM_Entry := TDSMEntryProc(GetProcAddress(hDSMLib, DSM_ENTRYPOINT));
      if @DSM_Entry <> nil then
      begin
        nState := 2;
      end
      else
      begin
        FreeLibrary(hDSMLib);
        hDSMLib := 0;
      end
    end
    else
    begin
      DSM_Entry := nil;
    end;
    result := (nState >= 2);
    //
    PTWainShared^.hDSMLib := hDSMLib;
    PTWainShared^.DSM_Entry := DSM_Entry;
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////
// use Force=true to really unloadsourcemanager

function IETW_UnloadSourceManager(var grec: tgrec; force: boolean): boolean;
begin
  with grec do
  begin
    LogWrite('IETW_UnloadSourceManager');
    if force and (PTWainShared^.hDSMLib <> 0) then
    begin
      FreeLibrary(hDSMLib);
      PTWainShared^.hDSMLib := 0;
      PTWainShared^.DSM_Entry := nil;
      nState := 1;
      LogWrite('  IETW_UnloadSourceManager : Unload OK');
    end
    else if (nState = 2) then
    begin
      if (hDSMLib <> 0) then
        hDSMLib := 0;
      DSM_Entry := nil;
      nState := 1;
      LogWrite('  IETW_UnloadSourceManager not Unloaded, for future uses');
    end;
    result := (nState = 1);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function CreateProxyWindow(var grec: tgrec): HWND;
var
  mainwnd: HWND;
begin
  LogWrite('CreateProxyWindow');
  if grec.PTWainShared.hproxy <> 0 then
  begin
    result := grec.PTWainShared^.hproxy;
    LogWrite('  CreateProxyWindow : already created');
    exit;
  end;

{$IFDEF OCXVERSION}
  mainwnd := HWND_DESKTOP;
{$ELSE}
  mainwnd := grec.callwnd;
  if mainwnd = 0 then
    mainwnd := HWND_DESKTOP;
{$ENDIF}

{$WARNINGS OFF}
  // Here memory debuggers could show a memory leak: it is not true, if DestroyWindow is not called by ImageEn
    // it is called by parent window.
  result := CreateWindow('STATIC', 'Acquire Proxy', WS_POPUPWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, // changed WS_POPUPWINDOW in 2.1.0
    CW_USEDEFAULT, CW_USEDEFAULT,
    mainwnd
    , 0, GetModuleHandle(nil), nil);
  if assigned(application) then
    application.processmessages;
  grec.PTWainShared.hproxy := result;
  LogWrite('  CreateProxyWindow : created');
{$WARNINGS ON}
end;

///////////////////////////////////////////////////////////////////////////////////////

procedure DestroyProxyWindow(wnd: HWND; var grec: tgrec; force: boolean);
begin
  LogWrite('DestroyProxyWindow');
  if force then
  begin
    // the window could be destroyed by parent
    if IsWindow(grec.PTWainShared^.hproxy) then
      DestroyWindow(grec.PTWainShared.hproxy);
    grec.PTWainShared.hproxy := 0;
    LogWrite('  DestroyProxyWindow : destroyed');
  end
  else
  begin
    LogWrite('  DestroyProxyWindow : not destroyed, for future uses');
  end;
end;

function ResultToStr(rsl: TW_UINT16): string;
begin
  case rsl of
    TWCC_BADCAP: Result := 'Capability not supported by Source or operation (get,set) is not supported on capability, or capability had dependencies on other capabilities and cannot be operated upon at this time';
    TWCC_BADDEST: Result := 'Unknown destination in DSM_Entry.';
    TWCC_BADPROTOCOL: Result := 'Unrecognized operation triplet.';
    TWCC_BADVALUE: Result := 'Data parameter out of supported range.';
    TWCC_BUMMER: Result := 'General failure. Unload Source immediately.';
    TWCC_CAPUNSUPPORTED: Result := 'Capability not supported by Source.';
    TWCC_CAPBADOPERATION: Result := 'Operation not supported on capability.';
    TWCC_CAPSEQERROR: Result := 'Capability has dependencies on other capabilities and cannot be operated upon at this time.';
    TWCC_DENIED: Result := 'File System operation is denied (file is protected).';
    TWCC_PAPERDOUBLEFEED: Result := 'Transfer failed because of a feeder error';
    TWCC_FILEEXISTS: Result := 'Operation failed because file already exists.';
    TWCC_FILENOTFOUND: Result := 'File not found.';
    TWCC_LOWMEMORY: Result := 'Not enough memory to complete operation.';
    TWCC_MAXCONNECTIONS: Result := 'Source is connected to maximum supported number of applications.';
    TWCC_NODS: Result := 'Source Manager unable to find the specified Source.';
    TWCC_NOTEMPTY: Result := 'Operation failed because directory is not empty.';
    TWCC_OPERATIONERROR: Result := 'Source or Source Manager reported an error to the user and handled the error; no application action required.';
    TWCC_PAPERJAM: Result := 'Transfer failed because of a feeder error';
    TWCC_SEQERROR: Result := 'Illegal operation for current Source Manager Source state.';
    TWCC_SUCCESS: Result := 'Operation worked.';
  else
    Result := 'Unknown Condition ' + inttostr(rsl);
  end;
end;

///////////////////////////////////////////////////////////////////////////////////////

function IETW_Mgr(var grec: tgrec; dg: TW_UINT32; dat: TW_UINT16; msg: TW_UINT16; pd: TW_MEMREF): boolean;
begin
  with grec do
  begin
    rc := TWRC_FAILURE;
    if (@DSM_Entry <> nil) then
    begin
      try
        rc := DSM_Entry(@AppId, nil, dg, dat, msg, pd);
        if (rc <> TWRC_SUCCESS) and assigned(TWParams) then
        begin
          TWParams.LastError := rc;
          TWParams.LastErrorStr := ResultToStr(rc);
          LogWrite('IETW_Mgr : ' + TWParams.LastErrorStr);
        end;
      except
      end;
    end;
    result := (rc = TWRC_SUCCESS);
  end;
end;