scanners.pas

控制扫描仪的源码,可以方便的控制扫描仪及照像机

{*******************************************************************

  Delphi Scanner Support Framework
  Copyright (C) 1999 by Uli Tessel

********************************************************************

  Version 0.0:
    Just some tests, not the real framework
    (only shows that native scanning from Delphi works)

********************************************************************}

unit Scanners;

interface

uses
  SysUtils, Windows, Messages, Graphics, Twain;

resourcestring // Errorstrings:
  SErrDSMEntryNotFound = 'DSMEntry not found in Twain DLL';
  SErrTwainNotLoaded = 'Twain DLL couldn''t be loaded';
  SErrDSMCallFailed = 'DSM Call failed in %s';
  SErrDSMUnknownError = 'DSM Call failed in %s: Code %.04x';
  SErrDSOpen = 'Cannot Close Source Manager: A Source is Currently Open';
  SErrCantGetStatus = 'Can''t get Status';
  STWErrGeneralDSM = 'DSM Error at %s:'#13'%s';
  STWErrGeneralDS = 'DS Error at %s:'#13'%s';

type
  // Exceptions:
  ETwainError = class(Exception);

{*******************************************************************
  LoadTwain
     Tries to load the Twain-DLL.
     Result is True if the lib was loaded successfully.

  Function is called automatically if needed.

  ToDo:
    Does this already mean a Scanner is available?
*******************************************************************}
function LoadTwain: Boolean;

{*******************************************************************
  UnloadTwain
     Removes the (previous) loaded Twain-DLL from Memory
*******************************************************************}
procedure UnloadTwain;

{*******************************************************************
  unsorted functions
  (Some should move to a DS class?!)
*******************************************************************}
procedure TWOpenDSM(hWnd: HWND);
procedure TWCloseDSM;
function TWIsDSMOpen: Boolean;
procedure TWOpenDS;
procedure TWCloseDS;
procedure TWEnableDS(show: Boolean);
procedure TWEnableDSUIOnly;
procedure TWDisableDS;
function TWIsDSOpen: Boolean;
function TWIsDSEnabled: Boolean;
procedure TWSelectDS;
function ProcessSourceMessage(var Msg: TMsg): Boolean;
procedure TWAcquire(hWnd: HWND; aBmp: TBitmap; show: Boolean);
function TWNativeTransfer: Boolean;

type
  TTWTransfer = (ttNative, ttMemory, ttFile);

implementation

const
  TWAIN_DLL_Name = 'TWAIN_32.DLL';
  DSM_Entry_Name = 'DSM_Entry';

(*******************************************************************
 Some (unsorted) global variables
*******************************************************************)
var
  bmp: TBitmap;  // the actual bmp used for scanning, must be removed
  HDSMDLL: HMODULE = 0;  // the library handle: will stay global
  appId: TW_IDENTITY;    // our (Application) ID. (may stay global)
  dsId: TW_IDENTITY;     // Data Source ID (will become member of DS class)
  hMainWnd: HWND;        // maybe will be removed, use application.handle instead

  TWDSMOpen: Boolean = False; // flag, may stay global
  TWDSOpen: Boolean = False;  // will become member of DS class
  TWDSEnabled: Boolean = False; // will become member of DS class

(*******************************************************************
  Load and unload twain dll
  is this conform to twain? (I don't check if 'fileExist', but
  LoadLibrary also does this and will fail if the DLL is not
  found?!)
  This code is currently used for applications, so no DS_Entry
  is used, and so that entry is not searched.
*******************************************************************)
function LoadTwain: Boolean;
begin
  if HDSMDLL =0 then
  begin
    HDSMDLL := LoadLibrary(TWAIN_DLL_Name);
    DSM_Entry := GetProcAddress(HDSMDLL, DSM_Entry_Name);

    if @DSM_Entry = nil then
      raise ETwainError.Create(SErrDSMEntryNotFound);
  end;

  Result := (HDSMDLL <> 0);
end;

procedure UnloadTwain;
begin
  if HDSMDLL <> 0 then
  begin
    DSM_Entry := nil;
    FreeLibrary(HDSMDLL);
    HDSMDLL := 0;
  end;
end;

(******************************************************************
 Some helping functions for error handling

ToDo:
 check texts, change to resourcestrings and move to
 something like a ScannersConst.pas unit
*******************************************************************)
function Condition2String(ConditionCode: TW_UINT16): string;
begin
  // Texts copied from PDF Documentation: Rework needed
  case ConditionCode of
    TWCC_BADCAP:
      Result :=
        'Capability not supported by Source or operation (get,'#13+
        'set) is not supported on capability, or capability had'#13+
        'dependencies on other capabilities and cannot be'#13+
        '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 '#13+
        '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'#13+
      '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'#13+
      'Source state.';
    TWCC_SUCCESS:
      Result := 'Operation worked.';
  else
    Result := Format('Unknown Condition %.04x', [ConditionCode]);
  end;
end;

(*******************************************************************
RaiseLastDSMCondition (idea: like RaiseLastWin32Error)
  Tries to get the status from the DSM and raises an exception
  with it.
*******************************************************************)
procedure RaiseLastDSMCondition(at: string);
var
  status: TW_STATUS;
begin
  Assert(@DSM_Entry <> nil);
  if DSM_Entry(@appId, nil, DG_CONTROL, DAT_STATUS, MSG_GET,
    @status) <> TWRC_SUCCESS then
    raise ETwainError.Create(SErrCantGetStatus)
  else
    raise ETwainError.CreateFmt(STWErrGeneralDSM, [at,
      Condition2String(status.ConditionCode)]);
end;

(*******************************************************************
RaiseLastDSCondition
  same again, but for the actual DS
  (should be a method of DS)
*******************************************************************)
procedure RaiseLastDSCondition(at: string);
var
  status: TW_STATUS;
begin
  Assert(@DSM_Entry <> nil);
  if DSM_Entry(@appId, @dsID, DG_CONTROL, DAT_STATUS, MSG_GET, @status) <>
    TWRC_SUCCESS then
   raise ETwainError.Create(SErrCantGetStatus)
  else
    raise ETwainError.CreateFmt(STWErrGeneralDS, [at,
      Condition2String(status.ConditionCode)]);
end;

(*******************************************************************
TwainCheckDSM (idea: like Win32Check or GDICheck in Graphics.pas)
*******************************************************************)
procedure TwainCheckDSM(res: TW_UINT16; at: string);
begin
  if res <> TWRC_SUCCESS then
  begin
    if res = TWRC_FAILURE then
      RaiseLastDSMCondition(at)
    else
      raise ETwainError.CreateFmt(SErrDSMUnknownError, [at, res]);
  end;
end;

(*******************************************************************
TwainCheckDS
  same again, but for the actual DS
(should be a method of DS)
*******************************************************************)
procedure TwainCheckDS(res: TW_UINT16; at: string);
begin
  if res <> TWRC_SUCCESS then
  begin
    if res = TWRC_FAILURE then
      RaiseLastDSCondition(at)
    else
      raise ETwainError.CreateFmt(SErrDSMUnknownError, [at, res]);
  end;
end;

(*******************************************************************
 CallDSMEntry:
  Short form for DSM Calls: appId is not neaded as parameter
*******************************************************************)
function CallDSMEntry(pDest: pTW_IDENTITY; DG: TW_UINT32; DAT: TW_UINT16;
  MSG: TW_UINT16; pData: TW_MEMREF): TW_UINT16;
begin
  Assert(@DSM_Entry <> nil);

  Result := DSM_Entry(@appID, pDest, DG, DAT, MSG, pData);
  if (Result <> TWRC_SUCCESS) and (DAT <> DAT_EVENT) then
  begin
  end;
end;

(*******************************************************************
  Short form for (actual) DS Calls. appId and dsID is not needed
(this should be a DS class method)
*******************************************************************)
function DSCall(DG: TW_UINT32; DAT: TW_UINT16; MSG: TW_UINT16;
  pData: TW_MEMREF): TW_UINT16;
begin
  Assert(@DSM_Entry <> nil);
  Result := DSM_Entry(@appID, @dsID, DG, DAT, MSG, pData);
end;

(*******************************************************************
  A lot of the following code is a conversion from the
  twain example program
  (and some comments are copied, too)

  (The error handling is done differently)

  Most functions should be moved to a DSM or DS class
*******************************************************************)

(*******************************************************************
  Functions from DCA_GLUE.C
*******************************************************************)
procedure TWOpenDSM(hWnd: HWND);
begin
  if not TWDSMOpen then
  begin
    Assert(hWnd <> 0);

    if not LoadTwain then
      raise ETwainError.Create(SErrTwainNotLoaded);

    appId.Id := 0;  // init to 0, but Source Manager will assign real value

    appId.Version.MajorNum := 1;
    appId.Version.MinorNum := 0;
    appId.Version.Language := TWLG_USA;
    appId.Version.Country := TWCY_USA;
    appId.Version.Info := 'Delphi Twain Test';

    appId.ProtocolMajor := 1; // TWON_PROTOCOLMAJOR;
    appId.ProtocolMinor := 7; //TWON_PROTOCOLMINOR;
    appId.SupportedGroups := DG_IMAGE or DG_CONTROL;

    appID.ProductName := 'TwainTest';
    appId.ProductFamily := 'Delphi Twain Framework';
    appId.Manufacturer := 'TeSoft';

    hMainWnd := hWnd;

    TwainCheckDSM(CallDSMEntry(nil, DG_CONTROL, DAT_PARENT, MSG_OPENDSM,
      @hMainWnd), 'TWOpenDSM');

    TWDSMOpen := True;
  end;
end;