{DELPHI IMPLEMENTATION OF TWAIN INTERFACE}
{december 2003? initially created by Gustavo Daud}

{This is my newest contribution for Delphi comunity, a powerfull}
{implementation of latest Twain features. As you know, twain is }
{the most common library to acquire images from most acquisition}
{devices such as Scanners and Web-Cameras.}

{Twain library is a bit different from other libraries, because}
{most of the hard work can be done by a a single method. Also it}
{automatically changes in the application message loop, which is}
{not a simple task, at least in delphi VCL.}

{It is not 100% sure to to Twain not to be installed in Windows,}
{as it ships with Windows and later and with most of the }
{acquisition device drivers (automatically with their installation)}
{This library dynamically calls the library, avoiding the application}
{hand when it is not present.}

{Also, as in most of my other components, I included a trigger}
{to allow the component to work without the heavy delphi VCL}
{for small final executables. To enable, edit DelphiTwain.inc}

{20/01/2004 - Some updates and bug fixes by Nemeth Peter}

{$INCLUDE DelphiTwain.inc}

unit DelphiTwain;

interface

{Used units}
uses
  Twain, Windows {$IFNDEF DONTUSEVCL}, Classes, SysUtils, Graphics{$ENDIF},
  DelphiTwainUtils;

const
  {Name of the Twain library for 32 bits enviroment}
  TWAINLIBRARY = 'TWAIN_32.DLL';
  VIRTUALWIN_CLASSNAME = 'DELPHITWAIN_VIRTUALWINDOW';

const
  {Error codes}
  ERROR_BASE              = 300;
  ERROR_INT16: TW_INT16   = HIGH(TW_INT16);

type
  {From twain}
  TW_STR255 = Twain.TW_STR255;

  {Forward declaration}
  TDelphiTwain = class;

  {Component kinds}
  {$IFDEF DONTUSEVCL} TTwainComponent = TObject;
  {$ELSE} TTwainComponent = TComponent; {$ENDIF}

  {File formats}
  TTwainFormat = (tfTIFF, tfPict, tfBMP, tfXBM, tfJPEG, tfFPX,
    tfTIFFMulti, tfPNG, tfSPIFF, tfEXIF, tfUnknown);
          {Twain units}
  TTwainUnit = (tuInches, tuCentimeters, tuPicas, tuPoints, tuTwips,
    tuPixels, tuUnknown);
  TTwainUnitSet = set of TTwainUnit;
  {Twain pixel flavor}
  TTwainPixelFlavor = (tpfChocolate, tpfVanilla, tpfUnknown);
  TTwainPixelFlavorSet = set of TTwainPixelFlavor;
  {Twain pixel type}
  TTwainPixelType = (tbdBw, tbdGray, tbdRgb, tbdPalette, tbdCmy, tbdCmyk,
    tbdYuv, tbdYuvk, tbdCieXYZ, tbdUnknown);
  TTwainPixelTypeSet = set of TTwainPixelType;
  {Twain bit depth}
  TTwainBitDepth = array of TW_UINT16;
  {Twain resolutions}
  TTwainResolution = array of Extended;

  {Events}
  TOnTwainError = procedure(Sender: TObject; const Index: Integer; ErrorCode,
    Additional: Integer) of object;
  TOnTwainAcquire = procedure(Sender: TObject; const Index: Integer; Image:
    {$IFNDEF DONTUSEVCL}TBitmap{$ELSE}HBitmap{$ENDIF};
    var Cancel: Boolean) of object;
  TOnAcquireProgress = procedure(Sender: TObject; const Index: Integer;
    const Image: HBitmap; const Current, Total: Integer) of object;
  TOnSourceNotify = procedure(Sender: TObject; const Index: Integer) of object;
  TOnSourceFileTransfer = procedure(Sender: TObject; const Index: Integer;
    Filename: TW_STR255; Format: TTwainFormat; var Cancel: Boolean) of object;

  {Avaliable twain languages}
  TTwainLanguage = ({-1}tlUserLocale, tlDanish, tlDutch, tlInternationalEnglish,
    tlFrenchCanadian, tlFinnish, tlFrench, tlGerman, tlIcelandic, tlItalian,
    tlNorwegian, tlPortuguese, tlSpanish, tlSwedish, tlUsEnglish,
    tlAfrikaans, tlAlbania, tlArabic, tlArabicAlgeria, tlArabicBahrain, {18}
    tlArabicEgypt, tlArabicIraq, tlArabJordan, tlArabicKuwait,
    tlArabicLebanon, tlArabicLibya, tlArabicMorocco, tlArabicOman,
    tlArabicQatar, tlArabicSaudiarabia, tlArabicSyria, tlArabicTunisia,
    tlArabicUae, tlArabicYemen, tlBasque, tlByelorussian, tlBulgarian,  {35}
    tlCatalan, tlChinese, tlChineseHongkong, tlChinesePeoplesRepublic,
    tlChineseSingapore, tlChineseSimplified, tlChineseTwain, {42}
    tlChineseTraditional, tlCroatia, tlCzech, tlDutchBelgian, {46}
    tlEnglishAustralian, tlEnglishCanadian, tlEnglishIreland,
    tlEnglishNewZealand, tlEnglishSouthAfrica, tlEnglishUk, {52}
    tlEstonian, tlFaeroese, tlFarsi, tlFrenchBelgian, tlFrenchLuxembourg, {57}
    tlFrenchSwiss, tlGermanAustrian, tlGermanLuxembourg, tlGermanLiechtenstein,
    tlGermanSwiss, tlGreek, tlHebrew, tlHungarian, tlIndonesian, {66}
    tlItalianSwiss, tlJapanese, tlKorean, tlKoreanJohab, tlLatvian, {71}
    tlLithuanian, tlNorewgianBokmal, tlNorwegianNynorsk, tlPolish, {75}
    tlPortugueseBrazil, tlRomanian, tlRussian, tlSerbianLatin,
    tlSlovak, tlSlovenian, tlSpanishMexican, tlSpanishModern, tlThai,
    tlTurkish, tlUkranian, tlAssamese, tlBengali, tlBihari, tlBodo,
    tlDogri, tlGujarati {92}, tlHarayanvi, tlHindi, tlKannada, tlKashmiri,
    tlMalayalam, tlMarathi, tlMarwari, tlMeghalayan, tlMizo, tlNaga {102},
    tlOrissi, tlPunjabi, tlPushtu, tlSerbianCyrillic, tlSikkimi,
    tlSwidishFinland, tlTamil, tlTelugu, tlTripuri, tlUrdu, tlVietnamese);
  {Twain supported groups}
  TTwainGroups = set of (tgControl, tgImage, tgAudio);

  {Transfer mode for twain}
  TTwainTransferMode = (ttmFile, ttmNative, ttmMemory);

  {rect for LAYOUT; npeter 2004.01.12.}
  TTwainRect =
   record
    Left:   double;
    Top:    double;
    Right:  double;
    Bottom: double;
   end;

  {Object to handle TW_IDENTITY}
  TTwainIdentity = class{$IFNDEF DONTUSEVCL}(TPersistent){$ENDIF}
  private
    {Structure which should be filled}
    Structure: TW_IDENTITY;
    {Owner}
    fOwner: {$IFNDEF DONTUSEVCL}TComponent{$ELSE}TObject{$ENDIF};
    {Returns/sets application language property}
    function GetLanguage(): TTwainLanguage;
    procedure SetLanguage(const Value: TTwainLanguage);
    {Returns/sets text values}
    function GetString(const Index: integer): String;
    procedure SetString(const Index: Integer; const Value: String);
    {Returns/sets avaliable groups}
    function GetGroups(): TTwainGroups;
    procedure SetGroups(const Value: TTwainGroups);
  protected
    {$IFNDEF DONTUSEVCL}function GetOwner(): TPersistent; override;{$ENDIF}
  public
    {Object being created}
    {$IFNDEF DONTUSEVCL} constructor Create(AOwner: TComponent);
    {$ELSE} constructor Create(AOwner: TObject); {$ENDIF}
    {Copy properties from another TTwainIdentity}
    {$IFDEF DONTUSEVCL} procedure Assign(Source: TObject); {$ELSE}
      procedure Assign(Source: TPersistent); override; {$ENDIF}
  published
    {Application major version}
    property MajorVersion: TW_UINT16 read Structure.Version.MajorNum
      write Structure.Version.MajorNum;
    {Application minor version}
    property MinorVersion: TW_UINT16 read Structure.Version.MinorNum
      write Structure.Version.MinorNum;
    {Language}
    property Language: TTwainLanguage read GetLanguage write SetLanguage;
    {Country code}
    property CountryCode: word read Structure.Version.Country write
      Structure.Version.Country;
    {Supported groups}
    property Groups: TTwainGroups read GetGroups write SetGroups;
    {Text values}
    property VersionInfo: String index 0 read GetString write
      SetString;
    property Manufacturer: String index 1 read GetString write
      SetString;
    property ProductFamily: String index 2 read GetString write
      SetString;
    property ProductName: String index 3 read GetString write
      SetString;
  end;

  {Return set for capability retrieving/setting}
  TCapabilityRet = (crSuccess, crUnsupported, crBadOperation, crDependencyError,
    crLowMemory, crInvalidState, crInvalidContainer);
  {Kinds of capability retrieving}
  TRetrieveCap = (rcGet, rcGetCurrent, rcGetDefault, rcReset);
  {Capability list type}
  TGetCapabilityList = array of string;
  TSetCapabilityList = array of pointer;

  {Source object}
  TTwainSource = class(TTwainIdentity)
  private
    {Holds the item index}
    fIndex: Integer;
    {Transfer mode for the images}
    fTransferMode: TTwainTransferMode;
    {Stores if user interface should be shown}
    fShowUI: Boolean;
    {Stores if the source window is modal}
    fModal: Boolean;
    {Stores if the source is enabled}
    fEnabled: Boolean;
    {Stores if the source is loaded}
    fLoaded: Boolean;
    {Stores the owner}
    fOwner: TDelphiTwain;
    {Used with property SourceManagerLoaded to test if the source manager}
    {is loaded or not.}
    function GetSourceManagerLoaded(): Boolean;
    {Returns a pointer to the application}
    function GetAppInfo(): pTW_IDENTITY;
    {Sets if the source is loaded}
    procedure SetLoaded(const Value: Boolean);
    {Sets if the source is enabled}
    procedure SetEnabled(const Value: Boolean);
    {Returns a pointer to the source pTW_IDENTITY}
    function GetStructure: pTW_IDENTITY;
    {Returns a resolution}
    function GetResolution(Capability: TW_UINT16; var Return: Extended;
      var Values: TTwainResolution; Mode: TRetrieveCap): TCapabilityRet;
  protected
    {Reads a native image}
    procedure ReadNative(Handle: TW_UINT32; var Cancel: Boolean);
    {Reads the file image}
    procedure ReadFile(Name: TW_STR255; Format: TW_UINT16; var Cancel: Boolean);
    {Call event for memory image}
    procedure ReadMemory(Image: HBitmap; var Cancel: Boolean);
  protected
    {Prepare image memory transference}
    function PrepareMemXfer(var BitmapHandle: HBitmap;
      var PixelType: TW_INT16): TW_UINT16;
    {Transfer image memory}
    function TransferImageMemory(var ImageHandle: HBitmap;
      PixelType: TW_INT16): TW_UINT16;
    {Returns a pointer to the TW_IDENTITY for the application}
    property AppInfo: pTW_IDENTITY read GetAppInfo;
    {Method to transfer the images}
    procedure TransferImages();
    {Message received in the event loop}
    function ProcessMessage(const Msg: TMsg): Boolean;
    {Returns if the source manager is loaded}
    property SourceManagerLoaded: Boolean read GetSourceManagerLoaded;
    {Source configuration methods}
    {************************}
  protected
    {Gets an item and returns it in a string}
    procedure GetItem(var Return: String; ItemType: TW_UINT16; Data: Pointer);
    {Converts from a result to a TCapabilityRec}
    function ResultToCapabilityRec(const Value: TW_UINT16): TCapabilityRet;
    {Sets a capability}
    function SetCapabilityRec(const Capability, ConType: TW_UINT16;
      Data: HGLOBAL): TCapabilityRet;
  public
    {Returns a capability strucutre}
    function GetCapabilityRec(const Capability: TW_UINT16;
      var Handle: HGLOBAL; Mode: TRetrieveCap;
      var Container: TW_UINT16): TCapabilityRet;
    {************************}
    {Returns an one value capability}
    function GetOneValue(Capability: TW_UINT16;
      var ItemType: TW_UINT16; var Value: string;
      Mode: TRetrieveCap{$IFDEF DEFAULTPARAM}=rcGet{$ENDIF};
      MemHandle: HGLOBAL{$IFDEF DEFAULTPARAM}=0{$ENDIF}): TCapabilityRet;
    {Returns an range capability}
    function GetRangeValue(Capability: TW_UINT16; var ItemType: TW_UINT16;
      var Min, Max, Step, Default, Current: String;
      MemHandle: HGLOBAL{$IFDEF DEFAULTPARAM}=0{$ENDIF}): TCapabilityRet;
    {Returns an enumeration capability}
    function GetEnumerationValue(Capability: TW_UINT16;
      var ItemType: TW_UINT16; var List: TGetCapabilityList; var Current,
      Default: Integer; Mode: TRetrieveCap{$IFDEF DEFAULTPARAM}=rcGet{$ENDIF};
      MemHandle: HGLOBAL{$IFDEF DEFAULTPARAM}=0{$ENDIF}): TCapabilityRet;
    {Returns an array capability}
    function GetArrayValue(Capability: TW_UINT16; var ItemType: TW_UINT16;
      var List: TGetCapabilityList; MemHandle: HGLOBAL
      {$IFDEF DEFAULTPARAM}=0{$ENDIF}): TCapabilityRet;
    {************************}
    {Sets an one value capability}
    function SetOneValue(Capability: TW_UINT16; ItemType: TW_UINT16;
      Value: Pointer): TCapabilityRet;
    {Sets a range capability}
    function SetRangeValue(Capability, ItemType: TW_UINT16; Min, Max, Step,
      Current: TW_UINT32): TCapabilityRet;
    {Sets an enumeration capability}
    function SetEnumerationValue(Capability, ItemType: TW_UINT16;
      CurrentIndex: TW_UINT32; List: TSetCapabilityList): TCapabilityRet;
    {Sets an array capability}
    function SetArrayValue(Capability, ItemType: TW_UINT16;
      List: TSetCapabilityList): TCapabilityRet;
  public
    {Setup file transfer}
    function SetupFileTransfer(Filename: String; Format: TTwainFormat): Boolean;
  protected
    {Used with property PendingXfers}
    function GetPendingXfers(): TW_INT16;
  public
    {Set source transfer mode}
    function ChangeTransferMode(NewMode: TTwainTransferMode): TCapabilityRet;
    {Returns return status information}
    function GetReturnStatus(): TW_UINT16;
    {Capability setting}
    {Set the number of images that the application wants to receive}
    function SetCapXferCount(Value: SmallInt): TCapabilityRet;
    {Returns the number of images that the source will return}
    function GetCapXferCount(var Return: SmallInt;
      Mode: TRetrieveCap{$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Retrieve the unit measure for all quantities}
    function GetICapUnits(var Return: TTwainUnit;
      var Supported: TTwainUnitSet; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Set the unit measure}
    function SetICapUnits(Value: TTwainUnit): TCapabilityRet;
    {npeter 2004.01.12 begin}
    function SetImagelayoutFrame(const fLeft,fTop,fRight,
      fBottom: double): TCapabilityRet;
    function SetIndicators(Value: boolean): TCapabilityRet;
    {npeter 2004.01.12 end}
    {Retrieve the pixel flavor values}
    function GetIPixelFlavor(var Return: TTwainPixelFlavor;
      var Supported: TTwainPixelFlavorSet; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Set the pixel flavor values}
    function SetIPixelFlavor(Value: TTwainPixelFlavor): TCapabilityRet;
    {Returns bitdepth values}
    function GetIBitDepth(var Return: Word;
      var Supported: TTwainBitDepth; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Set current bitdepth value}
    function SetIBitDepth(Value: Word): TCapabilityRet;
    {Returns pixel type values}
    function GetIPixelType(var Return: TTwainPixelType;
      var Supported: TTwainPixelTypeSet; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Set the pixel type value}
    function SetIPixelType(Value: TTwainPixelType): TCapabilityRet;
    {Returns X and Y resolutions}
    function GetIXResolution(var Return: Extended; var Values: TTwainResolution;
      Mode: TRetrieveCap {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    function GetIYResolution(var Return: Extended; var Values: TTwainResolution;
      Mode: TRetrieveCap {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Sets X and X resolutions}
    function SetIXResolution(Value: Extended): TCapabilityRet;
    function SetIYResolution(Value: Extended): TCapabilityRet;
    {Returns physical width and height}
    function GetIPhysicalWidth(var Return: Extended; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    function GetIPhysicalHeight(var Return: Extended; Mode: TRetrieveCap
      {$IFDEF DEFAULTPARAM}=rcGet{$ENDIF}): TCapabilityRet;
    {Returns if user interface is controllable}
    function GetUIControllable(var Return: Boolean): TCapabilityRet;
    {Returns feeder is loaded or not}
    function GetFeederLoaded(var Return: Boolean): TCapabilityRet;
    {Returns/sets if feeder is enabled}
    function GetFeederEnabled(var Return: Boolean): TCapabilityRet;
    function SetFeederEnabled(Value: WordBool): TCapabilityRet;
    {Returns/sets if auto feed is enabled}
    function GetAutofeed(var Return: Boolean): TCapabilityRet;
    function SetAutoFeed(Value: WordBool): TCapabilityRet;
    {Returns number of pending transfer}
    property PendingXfers: TW_INT16 read GetPendingXfers;
  public
    {Enables the source}
    function EnableSource(ShowUI, Modal: Boolean): Boolean;
    {Disables the source}
    function DisableSource: Boolean;
    {Loads the source}
    function LoadSource(): Boolean;
    {Unloads the source}
    function UnloadSource(): Boolean;
    {Returns a pointer to the source identity}
    property SourceIdentity: pTW_IDENTITY read GetStructure;
    {Returns/sets if the source is enabled}
    property Enabled: Boolean read fEnabled write SetEnabled;
    {Returns/sets if this source is loaded}
    property Loaded: Boolean read fLoaded write SetLoaded;
    {Object being created/destroyed}
    constructor Create(AOwner: TDelphiTwain);
    destructor Destroy; override;
    {Returns owner}
    property Owner: TDelphiTwain read fOwner;
    {Source window is modal}
    property Modal: Boolean read fModal write fModal;
    {Sets if user interface should be shown}
    property ShowUI: Boolean read fShowUI write fShowUI;
    {Transfer mode for transfering images from the source to}
    {the component and finally to the application}
    property TransferMode: TTwainTransferMode read fTransferMode
      write fTransferMode;
    {Returns the item index}
    property Index: Integer read fIndex;
    {Convert properties from write/read to read only}
    {(read description on TTwainIdentity source)}
    property MajorVersion: TW_UINT16 read Structure.Version.MajorNum;
    property MinorVersion: TW_UINT16 read Structure.Version.MinorNum;
    property Language: TTwainLanguage read GetLanguage;
    property CountryCode: word read Structure.Version.Country;
    property Groups: TTwainGroups read GetGroups;
    property VersionInfo: String index 0 read GetString;
    property Manufacturer: String index 1 read GetString;
    property ProductFamily: String index 2 read GetString;
    property ProductName: String index 3 read GetString;
  end;

  {Component part}
  TDelphiTwain = class(TTwainComponent)
  private
    {Should contain the number of Twain sources loaded}
    fSourcesLoaded: Integer;
    {Contains if the select source dialog is being displayed}
    SelectDialogDisplayed: Boolean;
  private
    {Event pointer holders}
    fOnSourceDisable: TOnSourceNotify;
    fOnAcquireCancel: TOnSourceNotify;
    fOnTwainAcquire: TOnTwainAcquire;
    fOnSourceSetupFileXfer: TOnSourceNotify;
    fOnSourceFileTransfer: TOnSourceFileTransfer;
    fOnAcquireError: TOnTwainError;
    fOnAcquireProgress: TOnAcquireProgress;
  private
    {Temp variable to allow SourceCount to be displayed in delphi}
    {property editor}
    fDummySourceCount: integer;
    {Contains list of source devices}
    DeviceList: TPointerList;
    {Contains a pointer to the structure with the application}
    {information}
    AppInfo: pTW_IDENTITY;
    {Holds the object to allow the user to set the application information}
    fInfo: TTwainIdentity;
    {Holds the handle for the virtual window which will receive}
    {twain message notifications}
    VirtualWindow: THandle;
    {Will hold Twain library handle}
    fHandle: HInst;
    {Holds if the component has enumerated the devices}
    fHasEnumerated: Boolean;
    {Holds twain dll procedure handle}
    fTwainProc: TDSMEntryProc;
    {Holds the transfer mode to be used}
    fTransferMode: TTwainTransferMode;
    {Contains if the library is loaded}
    fLibraryLoaded: Boolean;
    {Contains if the source manager was loaded}
    fSourceManagerLoaded: Boolean;
    {Procedure to load and unload twain library and update property}
    procedure SetLibraryLoaded(const Value: Boolean);
    {Procedure to load or unloaded the twain source manager}
    procedure SetSourceManagerLoaded(const Value: Boolean);
    {Updates the application information object}
    procedure SetInfo(const Value: TTwainIdentity);
    {Returns the number of sources}
    function GetSourceCount(): Integer;
    {Returns a source from the list}
    function GetSource(Index: Integer): TTwainSource;
    {Finds a matching source index}
    function FindSource(Value: pTW_IDENTITY): Integer;
  protected
    {Returns the default source}
    function GetDefaultSource: Integer;
    {Creates the virtual window}
    procedure CreateVirtualWindow();
    {Clears the list of sources}
    procedure ClearDeviceList();
  public
    {Allows Twain to display a dialog to let the user choose any source}
    {and returns the source index in the list}
    function SelectSource(): Integer;
    {Returns the number of loaded sources}
    property SourcesLoaded: Integer read fSourcesLoaded;
    {Enumerate the avaliable devices after Source Manager is loaded}
    function EnumerateDevices(): Boolean;
    {Object being created}
    {$IFNDEF DONTUSEVCL}
      constructor Create(AOwner: TComponent);override;
    {$ELSE}
      constructor Create;
    {$ENDIF}
    {Object being destroyed}
    destructor Destroy(); override;
    {Loads twain library and returns if it loaded sucessfully}
    function LoadLibrary(): Boolean;
    {Unloads twain and returns if it unloaded sucessfully}
    function UnloadLibrary(): Boolean;
    {Loads twain source manager}
    function LoadSourceManager(): Boolean;
    {Unloads the source manager}
    function UnloadSourceManager(forced: boolean): Boolean;
    {Returns the application TW_IDENTITY}
    property AppIdentity: pTW_IDENTITY read AppInfo;
    {Returns Twain library handle}
    property Handle: HInst read fHandle;
    {Returns a pointer to Twain only procedure}
    property TwainProc: TDSMEntryProc read fTwainProc;
    {Holds if the component has enumerated the devices}
    property HasEnumerated: Boolean read fHasEnumerated;
    {Returns a source}
    property Source[Index: Integer]: TTwainSource read GetSource;
  published
    {Events}
    {Source being disabled}
    property OnSourceDisable: TOnSourceNotify read fOnSourceDisable
      write fOnSourceDisable;
    {Acquire cancelled}
    property OnAcquireCancel: TOnSourceNotify read fOnAcquireCancel
      write fOnAcquireCancel;
    {Image acquired}
    property OnTwainAcquire: TOnTwainAcquire read fOnTwainAcquire
      write fOnTwainAcquire;
    {User should set information to prepare for the file transfer}
    property OnSourceSetupFileXfer: TOnSourceNotify read fOnSourceSetupFileXfer
      write fOnSourceSetupFileXfer;
    {File transfered}
    property OnSourceFileTransfer: TOnSourceFileTransfer read
      fOnSourceFileTransfer write fOnSourceFileTransfer;
    {Acquire error}
    property OnAcquireError: TOnTwainError read fOnAcquireError
      write fOnAcquireError;
    {Acquire progress, for memory transfers}
    property OnAcquireProgress: TOnAcquireProgress read fOnAcquireProgress
      write fOnAcquireProgress;
  published
    {Default transfer mode to be used with sources}
    property TransferMode: TTwainTransferMode read fTransferMode
      write fTransferMode;
    {Returns the number of sources, after Library and Source Manager}
    {has being loaded}
    property SourceCount: Integer read GetSourceCount write fDummySourceCount;
    {User should fill the application information}
    property Info: TTwainIdentity read fInfo write SetInfo;
    {Loads or unload Twain library}
    property LibraryLoaded: Boolean read fLibraryLoaded write SetLibraryLoaded;
    {Loads or unloads the source manager}
    property SourceManagerLoaded: Boolean read fSourceManagerLoaded write
      SetSourceManagerLoaded;
  end;

{Puts a string inside a TW_STR255}
function StrToStr255(Value: String): TW_STR255;
{This method returns if Twain is installed in the current machine}
function IsTwainInstalled(): Boolean;
{Called by Delphi to register the component}
procedure Register();
{Returns the size of a twain type}
function TWTypeSize(TypeName: TW_UINT16): Integer;

implementation

{Units used bellow}
uses
  Messages;

{Called by Delphi to register the component}
procedure Register();
begin
  {$IFNDEF DONTUSEVCL}
    RegisterComponents('NP', [TDelphiTwain]);
  {$ENDIF}
end;

{Returns the size of a twain type}
function TWTypeSize(TypeName: TW_UINT16): Integer;
begin
  {Test the type to return the size}
  case TypeName of
    TWTY_INT8  :  Result := sizeof(TW_INT8);
    TWTY_UINT8 :  Result := sizeof(TW_UINT8);
    TWTY_INT16 :  Result := sizeof(TW_INT16);
    TWTY_UINT16:  Result := sizeof(TW_UINT16);
    TWTY_INT32 :  Result := sizeof(TW_INT32);
    TWTY_UINT32:  Result := sizeof(TW_UINT32);
    TWTY_FIX32 :  Result := sizeof(TW_FIX32);
    TWTY_FRAME :  Result := sizeof(TW_FRAME);
    TWTY_STR32 :  Result := sizeof(TW_STR32);
    TWTY_STR64 :  Result := sizeof(TW_STR64);
    TWTY_STR128:  Result := sizeof(TW_STR128);
    TWTY_STR255:  Result := sizeof(TW_STR255);
    //npeter: the following types were not implemented
    //especially the bool caused problems
    TWTY_BOOL:    Result := sizeof(TW_BOOL);
    TWTY_UNI512:  Result := sizeof(TW_UNI512);
    TWTY_STR1024:  Result := sizeof(TW_STR1024);
    else          Result := 0;
  end {case}
end;

{Puts a string inside a TW_STR255}
function StrToStr255(Value: String): TW_STR255;
begin
  {Clean result}
  Fillchar(Result, sizeof(TW_STR255), #0);
  {If value fits inside the TW_STR255, copy memory}
  if Length(Value) <= sizeof(TW_STR255) then
    CopyMemory(@Result[0], @Value[1], Length(Value))
  else CopyMemory(@Result[0], @Value[1], sizeof(TW_STR255));
end;

{Returns full Twain directory (usually in Windows directory)}
function GetTwainDirectory(): String;
var
  i: TDirectoryKind;
  Dir: String;
begin
  {Searches in all the directories}
  FOR i := LOW(TDirectoryKind) TO HIGH(TDirectoryKind) DO
  begin

    {Directory to search}
    Dir := GetCustomDirectory(i);
    {Tests if the file exists in this directory}
    if FileExists(Dir + TWAINLIBRARY) then
    begin
      {In case it exists, returns this directory and exit}
      {the for loop}
      Result := Dir;
      Break;
    end {if FileExists}

  end {FOR i}
end;

{This method returns if Twain is installed in the current machine}
function IsTwainInstalled(): Boolean;
begin
  {If GetTwainDirectory function returns an empty string, it means}
  {that Twain was not found}
  Result := (GetTwainDirectory() <> '');
end;

{ TTwainIdentity object implementation }

{Object being created}
{$IFNDEF DONTUSEVCL} constructor TTwainIdentity.Create(AOwner: TComponent);
{$ELSE} constructor TTwainIdentity.Create(AOwner: TObject); {$ENDIF}
begin
  {Allows ancestor to work}
  inherited Create;

  {Set initial properties}
  FillChar(Structure, sizeof(Structure), #0);
  Language := tlUserLocale;
  CountryCode := 1;
  MajorVersion := 1;
  VersionInfo := 'Application name';
  Structure.ProtocolMajor := TWON_PROTOCOLMAJOR;
  Structure.ProtocolMinor := TWON_PROTOCOLMINOR;
  Groups := [tgImage, tgControl];
  Manufacturer := 'Application manufacturer';
  ProductFamily := 'App product family';
  ProductName := 'App product name';

  fOwner := AOwner; {Copy owner pointer}
end;

{$IFNDEF DONTUSEVCL}
function TTwainIdentity.GetOwner(): TPersistent;
begin
  Result := fOwner;
end;
{$ENDIF}

{Sets a text value}
procedure TTwainIdentity.SetString(const Index: Integer;
  const Value: String);
var
  PropStr: PChar;
begin
  {Select and copy pointer}
  case Index of
    0: PropStr := @Structure.Version.Info[0];
    1: PropStr := @Structure.Manufacturer[0];
    2: PropStr := @Structure.ProductFamily[0];
  else PropStr := @Structure.ProductName[0];
  end {case};

  {Set value}
  Fillchar(PropStr^, sizeof(TW_STR32), #0);
  if Length(Value) > sizeof(TW_STR32) then
    CopyMemory(PropStr, @Value[1], sizeof(TW_STR32))
  else
    CopyMemory(PropStr, @Value[1], Length(Value));
end;

{Returns a text value}
function TTwainIdentity.GetString(const Index: Integer): String;
begin
  {Test for the required property}
  case Index of
    0: Result := Structure.Version.Info;
    1: Result := Structure.Manufacturer;
    2: Result := Structure.ProductFamily;
  else Result := Structure.ProductName;
  end {case}
end;

{Returns application language property}
function TTwainIdentity.GetLanguage(): TTwainLanguage;
begin
  Result := TTwainLanguage(Structure.Version.Language + 1);
end;

{Sets application language property}
procedure TTwainIdentity.SetLanguage(const Value: TTwainLanguage);
begin
  Structure.Version.Language := Word(Value) - 1;
end;

{Copy properties from another TTwainIdentity}
{$IFDEF DONTUSEVCL} procedure TTwainIdentity.Assign(Source: TObject);
{$ELSE} procedure TTwainIdentity.Assign(Source: TPersistent); {$ENDIF}
begin
  {The source should also be a TTwainIdentity}
  if Source is TTwainIdentity then
    {Copy properties}
    Structure := TTwainIdentity(Source).Structure
  else
    {$IFNDEF DONTUSEVCL}inherited; {$ENDIF}
end;

{Returns avaliable groups}
function TTwainIdentity.GetGroups(): TTwainGroups;
begin
  {Convert from Structure.SupportedGroups to TTwainGroups}
  Include(Result, tgControl);
  if DG_IMAGE AND Structure.SupportedGroups <> 0 then
    Include(Result, tgImage);
  if DG_AUDIO AND Structure.SupportedGroups <> 0 then
    Include(Result, tgAudio);
end;

{Sets avaliable groups}
procedure TTwainIdentity.SetGroups(const Value: TTwainGroups);
begin
  {Convert from TTwainGroups to Structure.SupportedGroups}
  Structure.SupportedGroups := DG_CONTROL;
  if tgImage in Value then
    Structure.SupportedGroups := Structure.SupportedGroups or DG_IMAGE;
  if tgAudio in Value then
    Structure.SupportedGroups := Structure.SupportedGroups or DG_AUDIO;
end;

{ TDelphiTwain component implementation }

{Loads twain library and returns if it loaded sucessfully}
function TDelphiTwain.LoadLibrary(): Boolean;
var
  TwainDirectory: String;
begin
  {The library must not be already loaded}
  if (not LibraryLoaded) then
  begin
    Result := FALSE; {Initially returns FALSE}
    {Searches for Twain directory}
    TwainDirectory := GetTwainDirectory();
    {Continue only if twain is installed in an known directory}
    if TwainDirectory <> '' then
    begin

      fHandle := Windows.LoadLibrary(PChar(TwainDirectory + TWAINLIBRARY));
      {If the library was sucessfully loaded}
      if (fHandle <> INVALID_HANDLE_VALUE) then
      begin

        {Obtains method handle}
        @fTwainProc := GetProcAddress(fHandle, MAKEINTRESOURCE(1));
        {Returns TRUE/FALSE if the method was obtained}
        Result := (@fTwainProc <> nil);

        {If the method was not obtained, also free the library}
        if not Result then
        begin
          {Free the handle and clears the variable}
          Windows.FreeLibrary(fHandle);
          fHandle := 0;
        end {if not Result}
      end
      else
        {If it was not loaded, clears handle value}
        fHandle := 0;

    end {if TwainDirectory <> ''};

  end
  else
    {If it was already loaded, returns true, since that is}
    {what was supposed to happen}
    Result := TRUE;

  {In case the method was sucessful, updates property}
  if Result then fLibraryLoaded := TRUE;
end;


{Unloads twain and returns if it unloaded sucessfully}
function TDelphiTwain.UnloadLibrary(): Boolean;
begin
  {The library must not be already unloaded}
  if (LibraryLoaded) then
  begin
    {Unloads the source manager}
    SourceManagerLoaded := FALSE;
    {Just call windows method to unload}
    Result := Windows.FreeLibrary(Handle);
    {If it was sucessfull, also clears handle value}
    if Result then fHandle := 0;
    {Updates property}
    fLibraryLoaded := not Result;
  end
  else
    {If it was already unloaded, returns true, since that is}
    {what was supposed to happen}
    Result := TRUE;

  {In case the method was sucessful, updates property}
  if Result then fLibraryLoaded := FALSE;
end;

{Enumerate the avaliable devices after Source Manager is loaded}
function TDelphiTwain.EnumerateDevices(): Boolean;
var
  NewSource: TTwainSource;
  CallRes  : TW_UINT16;
begin
  {Booth library and source manager must be loaded}
  if (LibraryLoaded and SourceManagerLoaded) then
  begin
    {Clears the preview list of sources}
    ClearDeviceList();

    {Allocate new identity and tries to enumerate}
    NewSource := TTwainSource.Create(Self);
    CallRes := TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY,
      MSG_GETFIRST, @NewSource.Structure);
    if CallRes = TWRC_SUCCESS then
      repeat

        {Add this item to the list}
        DeviceList.Add(NewSource);
        {Allocate memory for the next}
        NewSource := TTwainSource.Create(Self);
        NewSource.TransferMode := Self.TransferMode;
        NewSource.fIndex := DeviceList.Count;

      {Try to get the next item}
      until TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY,
        MSG_GETNEXT, @NewSource.Structure) <> TWRC_SUCCESS;

    {Set that the component has enumerated the devices}
    {if everything went correctly}
    Result := TRUE;
    fHasEnumerated := Result;

    {Dispose un-needed source object}
    NewSource.Free;

  end
  else Result := FALSE; {If library and source manager aren't loaded}
end;

{Procedure to load and unload twain library and update property}
procedure TDelphiTwain.SetLibraryLoaded(const Value: Boolean);
begin
  {The value must be changing to activate}
  if (Value <> fLibraryLoaded) then
  begin
    {Depending on the parameter load/unload the library and updates}
    {property whenever it loaded or unloaded sucessfully}
    if Value           then  LoadLibrary()
    else {if not Value then} UnloadLibrary();

  end {if (Value <> fLibraryLoaded)}
end;

{Loads twain source manager}
function TDelphiTwain.LoadSourceManager(): Boolean;
begin
  {The library must be loaded}
  if LibraryLoaded and not SourceManagerLoaded then
    {Loads source manager}
    Result := (fTwainProc(AppInfo, nil, DG_CONTROL, DAT_PARENT,
      MSG_OPENDSM, @VirtualWindow) = TWRC_SUCCESS)
  else
    {The library is not loaded, thus the source manager could}
    {not be loaded}
    Result := FALSE or SourceManagerLoaded;

  {In case the method was sucessful, updates property}
  if Result then fSourceManagerLoaded := TRUE;
end;

{UnLoads twain source manager}
function TDelphiTwain.UnloadSourceManager(forced: boolean): Boolean;
begin
  {The library must be loaded}
  if LibraryLoaded and SourceManagerLoaded then
  begin
    {Clears the list of sources}
    ClearDeviceList();
    {Unload source manager}
    if not forced then
     Result := (TwainProc(AppInfo, nil, DG_CONTROL, DAT_PARENT, MSG_CLOSEDSM, @VirtualWindow) = TWRC_SUCCESS)
    else result:=true; 
  end
  else
    {The library is not loaded, meaning that the Source Manager isn't either}
    Result := TRUE;

  {In case the method was sucessful, updates property}
  if Result then fSourceManagerLoaded := FALSE;
end;

{Procedure to load or unloaded the twain source manager}
procedure TDelphiTwain.SetSourceManagerLoaded(const Value: Boolean);
begin
  {The library must be loaded to have access to the method}
  if LibraryLoaded and (Value <> fSourceManagerLoaded) then
  begin
    {Load/unload the source manager}
    if Value           then  LoadSourceManager()
    else {if not Value then} UnloadSourceManager(false);
  end {if LibraryLoaded}
end;

{Clears the list of sources}
procedure TDelphiTwain.ClearDeviceList();
var
  i: Integer;
begin
  {Deallocate pTW_IDENTITY}
  FOR i := 0 TO DeviceList.Count - 1 DO
    TTwainSource(DeviceList.Item[i]).Free;
  {Clears the list}
  DeviceList.Clear;
  {Set trigger to tell that it has not enumerated again yet}
  fHasEnumerated := FALSE;

end;

{Finds a matching source index}
function TDelphiTwain.FindSource(Value: pTW_IDENTITY): Integer;
var
  i       : Integer;
begin
  Result := -1; {Default result}
  
  {Search for this source in the list}
  for i := 0 TO SourceCount - 1 DO
    if CompareMem(@Source[i].Structure, pChar(Value), SizeOf(TW_IDENTITY)) then
    begin
      {Return index and exit}
      Result := i;
      break;
    end; {if CompareMem, for i}
end;

{Allows Twain to display a dialog to let the user choose any source}
{and returns the source index in the list}
function TDelphiTwain.SelectSource: Integer;
var
  Identity: TW_IDENTITY;
begin
  Result := -1;     {Default result}
  {Booth library and source manager must be loaded}
  if (LibraryLoaded and SourceManagerLoaded and not SelectDialogDisplayed) then
  begin
    {Don't allow this dialog to be displayed twice}
    SelectDialogDisplayed := TRUE;

    {Call twain to display the dialog}
    if TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY, MSG_USERSELECT,
      @Identity) = TWRC_SUCCESS then
      Result := FindSource(@Identity);

    {Ended using}
    SelectDialogDisplayed := FALSE
  end {(LibraryLoaded and SourceManagerLoaded)}
end;

{Returns the number of sources}
function TDelphiTwain.GetSourceCount(): Integer;
begin
  {Library and source manager must be loaded}
  if (LibraryLoaded and SourceManagerLoaded) then
  begin
    {Enumerate devices, if needed}
    if not HasEnumerated then EnumerateDevices();
    {Returns}
    Result := DeviceList.Count;
  end
  {In case library and source manager aren't loaded, returns 0}
  else Result := 0
end;

{Returns the default source}
function TDelphiTwain.GetDefaultSource: Integer;
var
  Identity: TW_IDENTITY;
begin
  {Call twain to display the dialog}
  if SourceManagerLoaded and (TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY,
    MSG_GETDEFAULT, @Identity) = TWRC_SUCCESS) then
    Result := FindSource(@Identity)
  else Result := 0 {Returns}
end;

{Returns a source from the list}
function TDelphiTwain.GetSource(Index: Integer): TTwainSource;
begin
  {Booth library and source manager must be loaded}
  if (LibraryLoaded and SourceManagerLoaded) then
  begin

    {If index is in range, returns}
    {(Call to SourceCount property enumerates the devices, if needed)}
    if Index in [0..SourceCount - 1] then
      Result := DeviceList.Item[Index]
    else if (Index = -1) and (SourceCount > 0) then
      Result := DeviceList.Item[GetDefaultSource]
    {Unknown object, returns nil}
    else Result := nil;

  end
  {In case either the library or the source manager aren't}
  {loaded, it returns nil}
  else Result := nil
end;

{Object being created}
constructor TDelphiTwain.Create{$IFNDEF DONTUSEVCL}(AOwner: TComponent){$ENDIF};
begin
  {Let the ancestor class also handle the call}
  inherited;

  {Create source list}
  DeviceList := TPointerList.Create;
  {Clear variables}
  fSourcesLoaded := 0;
  fHandle := 0;
  @fTwainProc := nil;
  SelectDialogDisplayed := FALSE;
  fSourceManagerLoaded := FALSE;
  fHasEnumerated := FALSE;
  fTransferMode := ttmMemory;
  {Creates the virtual window which will intercept messages}
  {from Twain}
  CreateVirtualWindow();
  {Creates the object to allow the user to set the application}
  {information to inform twain source manager and sources}
  fInfo := TTwainIdentity.Create(Self);
  AppInfo := @fInfo.Structure;
end;

{Object being destroyed}
destructor TDelphiTwain.Destroy;
begin
  {Full unload the library}
  LibraryLoaded := FALSE;
  {Free the virtual window handle}
  DestroyWindow(VirtualWindow);
  {Free the object}
  fInfo.Free;
  {Clears and free source list}
  ClearDeviceList();
  DeviceList.Free();
  {Let ancestor class handle}
  inherited Destroy;
end;

{Creates the virtual window}
procedure TDelphiTwain.CreateVirtualWindow;
begin
  {Creates the window and passes a pointer to the class object}
  VirtualWindow := CreateWindow(VIRTUALWIN_CLASSNAME, 'Delphi Twain virtual ' +
    'window', 0, 10, 10, 100, 100, 0, 0, hInstance, Self);
end;

{Updates the application information object}
procedure TDelphiTwain.SetInfo(const Value: TTwainIdentity);
begin
  {Assign one object to another}
  fInfo.Assign(Value);
end;

{ TTwainSource object implementation }

{Used with property SourceManagerLoaded to test if the source manager}
{is loaded or not.}
function TTwainSource.GetSourceManagerLoaded: Boolean;
begin
  {Obtain information from owner TDelphiTwain}
  Result := Owner.SourceManagerLoaded;
end;

{Sets if the source is loaded}
procedure TTwainSource.SetLoaded(const Value: Boolean);
begin
  {Value should be changing}
  if (Value <> fLoaded) then
  begin
    {Loads or unloads the source}
    if Value           then  LoadSource()
    else {if not Value then} UnloadSource();
  end {if (Value <> fLoaded)}
end;

{Sets if the source is enabled}
procedure TTwainSource.SetEnabled(const Value: Boolean);
begin
  {Source must be already enabled and value changing}
  if (Loaded) and (Value <> fEnabled) then
  begin
    {Enables/disables}
    if Value           then  EnableSource(ShowUI, Modal)
    else {if not Value then} DisableSource();
  end {if (Loaded) and (Value <> fEnabled)}
end;

{Enables the source}
function TTwainSource.EnableSource(ShowUI, Modal: Boolean): Boolean;
var
  twUserInterface: TW_USERINTERFACE;
begin
  {Source must be loaded and the value changing}
  if (Loaded) and (not Enabled) then
  begin
    {Builds UserInterface structure}
    twUserInterface.ShowUI := ShowUI;
    twUserInterface.ModalUI := Modal;
    twUserInterface.hParent := owner.VirtualWindow;
    //npeter may be it is better to send messages to VirtualWindow
    //I am not sure, but it seems more stable with a HP TWAIN driver
    //it was: := GetActiveWindow;
    fEnabled := TRUE;
    {Call method}
    Result := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL,
      DAT_USERINTERFACE, MSG_ENABLEDS, @twUserInterface) in
      [TWRC_SUCCESS, TWRC_CHECKSTATUS]);
  end
  else {If it's either not loaded or already enabled}
    {If it is not loaded}
    Result := FALSE or Enabled;

  {Updates property}
  if (Result = TRUE) then fEnabled := TRUE;
end;

{Disables the source}
function TTwainSource.DisableSource(): Boolean;
var
  twUserInterface: TW_USERINTERFACE;
begin
  {Source must be loaded and the value changing}
  if (Loaded) and (Enabled) then
  begin

    {Call method}
    Result := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL,
      DAT_USERINTERFACE, MSG_DISABLEDS, @twUserInterface) = TWRC_SUCCESS);
    {Call notification event if being used}
    if (Result) and (Assigned(Owner.OnSourceDisable)) then
      Owner.OnSourceDisable(Owner, Index);

  end
  else {If it's either not loaded or already disabled}
    {If it is not loaded}
    Result := TRUE;

  {Updates property}
  if (Result = TRUE) then fEnabled := FALSE;
end;

{Loads the source}
function TTwainSource.LoadSource: Boolean;
begin
  {Only loads if it is not already loaded}
  if Not Loaded then
  begin
    Result := (Owner.TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY,
      MSG_OPENDS, @Structure) = TWRC_SUCCESS);
    {Increase the loaded sources count variable}
    if Result then inc(Owner.fSourcesLoaded);
  end
  else
    {If it was already loaded, returns true}
    Result := TRUE;

  {In case the method was sucessful, updates property}
  if Result then
    fLoaded := TRUE;

end;

{Unloads the source}
function TTwainSource.UnloadSource: Boolean;
begin
  {Only unloads if it is loaded}
  if Loaded then
  begin
    {If the source was enabled, disable it}
    DisableSource();
    {Call method to load}
    Result := (Owner.TwainProc(AppInfo, nil, DG_CONTROL, DAT_IDENTITY,
      MSG_CLOSEDS, @Structure) = TWRC_SUCCESS);
    {Decrease the loaded sources count variable}
    if Result then dec(Owner.fSourcesLoaded);
  end
  else
    {If it was already unloaded, returns true}
    Result := TRUE;

  {In case the method was sucessful, updates property}
    fLoaded := FALSE;
end;

{Object being destroyed}
destructor TTwainSource.Destroy;
begin
  {If loaded, unloads source}
  UnloadSource();
  {Let ancestor class process}
  inherited Destroy;
end;

{Returns a pointer to the application}
function TTwainSource.GetAppInfo: pTW_IDENTITY;
begin
  Result := Owner.AppInfo;
end;

{Returns a pointer to the source identity}
function TTwainSource.GetStructure: pTW_IDENTITY;
begin
  Result := @Structure;
end;

{Object being created}
constructor TTwainSource.Create(AOwner: TDelphiTwain);
begin
  {Allows ancestor class to process}
  inherited Create(AOwner);

  {Initial values}
  fTransferMode := ttmNative;
  fLoaded := FALSE;
  fShowUI := TRUE;
  fEnabled := FALSE;
  fModal := TRUE;
  {Stores owner}
  fOwner := AOwner;
end;

{Set source transfer mode}
function TTwainSource.ChangeTransferMode(
  NewMode: TTwainTransferMode): TCapabilityRet;
const
  TransferModeToTwain: Array[TTwainTransferMode] of TW_UINT16 =
    (TWSX_FILE, TWSX_NATIVE, TWSX_MEMORY);
var
  Value: TW_UINT16;
begin
  {Set transfer mode method}
  Value := TransferModeToTwain[NewMode];
  Result := SetOneValue(ICAP_XFERMECH, TWTY_UINT16, @Value);
  TransferMode := NewMode;
end;

{Message received in the event loop}
function TTwainSource.ProcessMessage(const Msg: TMsg): Boolean;
var
  twEvent: TW_EVENT;
begin
  {Make twEvent structure}
  twEvent.TWMessage := MSG_NULL;
  twEvent.pEvent := TW_MEMREF(@Msg);
  {Call Twain procedure to handle message}
  Result := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_EVENT,
    MSG_PROCESSEVENT, @twEvent) = TWRC_DSEVENT);

  {If it is a message from the source, process}
  if Result then
    case twEvent.TWMessage of
      {No message from the source}
      MSG_NULL: exit;
      {Requested to close the source}
      MSG_CLOSEDSREQ:
      begin
        {Call notification event}
        if (Assigned(Owner.OnAcquireCancel)) then
          Owner.OnAcquireCancel(Owner, Index);
        {Disable the source}
        DisableSource();
      end;
      {Ready to transfer the images}
      MSG_XFERREADY:
        {Call method to transfer}
        TransferImages();

      MSG_CLOSEDSOK:
       result:=true;

      MSG_DEVICEEVENT:
       result:=true;

    end {case twEvent.TWMessage}
end;

{Returns return status information}
function TTwainSource.GetReturnStatus: TW_UINT16;
var
  StatusInfo: TW_STATUS;
begin
  {The source must be loaded in order to get the status}
  if Loaded then
  begin
    {Call method to get the information}
    Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_STATUS, MSG_GET,
      @StatusInfo);
    Result := StatusInfo.ConditionCode;
  end else Result := 0 {In case it was called while the source was not loaded}
end;

{Converts from a result to a TCapabilityRec}
function TTwainSource.ResultToCapabilityRec(
  const Value: TW_UINT16): TCapabilityRet;
begin

  {Test result code to return}
  case Value of
    {Successull, copy handle and return a success value}
    TWRC_SUCCESS: Result := crSuccess;
    {Error, get more on the error, and return result}
    {case} else
      case GetReturnStatus() of
         TWCC_CAPUNSUPPORTED: Result := crUnsupported;
         TWCC_CAPBADOPERATION: Result := crBadOperation;
         TWCC_CAPSEQERROR: Result := crDependencyError;
         TWCC_LOWMEMORY: Result := crLowMemory;
         TWCC_SEQERROR: Result := crInvalidState;
         else Result := crBadOperation;
      end {case GetReturnStatus of}
  end {case};

end;

{Sets a capability}
function TTwainSource.SetCapabilityRec(const Capability,
  ConType: TW_UINT16; Data: HGlobal): TCapabilityRet;
var
  CapabilityInfo: TW_CAPABILITY;
begin
  {Source must be loaded to set}
  if Loaded then
  begin

    {Fill structure}
    CapabilityInfo.Cap := Capability;
    CapabilityInfo.ConType := ConType;
    CapabilityInfo.hContainer := Data;

    {Call method and store return}
    Result := ResultToCapabilityRec(Owner.TwainProc(AppInfo, @Structure,
      DG_CONTROL, DAT_CAPABILITY, MSG_SET, @CapabilityInfo));

  end
  else Result := crInvalidState  {In case the source is not loaded}
end;

{Returns a capability strucutre}
function TTwainSource.GetCapabilityRec( const Capability: TW_UINT16;
  var Handle: HGLOBAL; Mode: TRetrieveCap;
  var Container: TW_UINT16): TCapabilityRet;
const
  ModeToTwain: Array[TRetrieveCap] of TW_UINT16 = (MSG_GET, MSG_GETCURRENT,
    MSG_GETDEFAULT, MSG_RESET);
var
  CapabilityInfo: TW_CAPABILITY;
begin
  {Source must be loaded}
  if Loaded then
  begin

    {Fill structure}
    CapabilityInfo.Cap := Capability;
    CapabilityInfo.ConType := TWON_DONTCARE16;
    CapabilityInfo.hContainer := 0;

    {Call method and store return}
    Result := ResultToCapabilityRec(Owner.TwainProc(AppInfo, @Structure,
      DG_CONTROL, DAT_CAPABILITY, ModeToTwain[Mode], @CapabilityInfo));

    if Result = crSuccess then
    begin
      Handle := CapabilityInfo.hContainer;
      Container := CapabilityInfo.ConType;
    end
  end {if not Loaded}
  else Result := crInvalidState  {In case the source is not loaded}
end;

{Gets an item and returns it in a string}
procedure TTwainSource.GetItem(var Return: String; ItemType: TW_UINT16;
  Data: Pointer);
begin
  {Test the item type}
  case ItemType of
    TWTY_INT8   :         Return := IntToStr(pTW_INT8(Data)^);
    TWTY_UINT8  :         Return := IntToStr(pTW_UINT8(Data)^);
    TWTY_INT16,
    44 {TWTY_HANDLE} :    Return := IntToStr(pTW_INT16(Data)^);
    TWTY_UINT16,
    TWTY_BOOL   :         Return := IntToStr(pTW_UINT16(Data)^);
    TWTY_INT32  :         Return := IntToStr(pTW_INT32(Data)^);
    TWTY_UINT32,
    43 {TWTY_MEMREF} :    Return := IntToStr(pTW_UINT32(Data)^);
    {Floating integer type}
    TWTY_FIX32:
      with pTW_FIX32(Data)^ do
        //npeter bugfix:
        //it is better to use the actual decimal separator
        //and not a wired in value!
        //If not, you may get error on strtofloat
        //original: Return := IntToStr(Whole) + ',' + IntToStr(Frac);
        Return := IntToStr(Whole)+ IntToStr(Frac);   //  + decimalseparator
    {String types, which are all ended by a null char (#0)}
    TWTY_STR32,
    TWTY_STR64,
    TWTY_STR128,
    TWTY_STR255 :         Return := PChar(Data);

  end {case ItemType}
end;

{Returns an array capability}
function TTwainSource.GetArrayValue(Capability: TW_UINT16;
  var ItemType: TW_UINT16; var List: TGetCapabilityList;
  MemHandle: HGLOBAL): TCapabilityRet;
var
  ArrayV   : pTW_ARRAY;
  ItemSize : Integer;
  Data     : PChar;
  CurItem  : Integer;
  Value    : String;
  Container: TW_UINT16;
begin
  {Call method to get the memory to the return}
  if MemHandle = 0 then
    Result := GetCapabilityRec(Capability, MemHandle, rcGet, Container)
  else
  begin
    Result := crSuccess;
    Container := TWON_ARRAY;
  end;

  if (Result = crSuccess) and (Container <> TWON_ARRAY) then
  begin
    Result := crInvalidContainer;
    GlobalFree(MemHandle);
    Exit;
  end;

  {If result was sucessfull and memory was allocated}
  if (Result = crSuccess) then
  begin
    {Obtain structure pointer}
    ArrayV := GlobalLock(MemHandle);

    {Fill return properties}
    ItemType := ArrayV^.ItemType;

    {Prepare to list items}
    ItemSize := TWTypeSize(ItemType);
    Data := @ArrayV^.ItemList[0];
    SetLength(List, ArrayV^.NumItems);

    {Copy items}
    for CurItem := 0 TO ArrayV^.NumItems - 1 do
    begin
      {Obtain this item}
      GetItem(Value, ItemType, Data);
      List[CurItem] := Value;
      {Move memory to the next}
      inc(Data, ItemSize);
    end;


    {Unlock memory and unallocate}
    GlobalUnlock(MemHandle);
    GlobalFree(MemHandle);
  end {if (Result = crSuccess)}
end;

{Returns an enumeration capability}
function TTwainSource.GetEnumerationValue(Capability: TW_UINT16;
  var ItemType: TW_UINT16; var List: TGetCapabilityList;
  var Current, Default: Integer; Mode: TRetrieveCap;
  MemHandle: HGLOBAL): TCapabilityRet;
var
  EnumV    : pTW_ENUMERATION;
  ItemSize : Integer;
  Data     : PChar;
  CurItem  : Integer;
  Value    : String;
  Container: TW_UINT16;
begin
  {Call method to get the memory to the return}
  if MemHandle = 0 then
    Result := GetCapabilityRec(Capability, MemHandle, Mode, Container)
  else
  begin
    Result := crSuccess;
    Container := TWON_ENUMERATION;
  end;

  if (Result = crSuccess) and (Container <> TWON_ENUMERATION) then
  begin
    Result := crInvalidContainer;
    GlobalFree(MemHandle);
    Exit;
  end;

  {If result was sucessfull and memory was allocated}
  if (Result = crSuccess) then
  begin
    {Obtain structure pointer}
    EnumV := GlobalLock(MemHandle);

    {Fill return properties}
    Current := EnumV^.CurrentIndex;
    Default := EnumV^.DefaultIndex;
    ItemType := EnumV^.ItemType;

    {Prepare to list items}
    ItemSize := TWTypeSize(ItemType);
    Data := @EnumV^.ItemList[0];
    SetLength(List, EnumV^.NumItems);

    {Copy items}
    for CurItem := 0 TO EnumV^.NumItems - 1 do
    begin
      {Obtain this item}
      GetItem(Value, ItemType, Data);
      List[CurItem] := Value;
      {Move memory to the next}
      inc(Data, ItemSize);
    end;


    {Unlock memory and unallocate}
    GlobalUnlock(MemHandle);
    GlobalFree(MemHandle);
  end {if (Result = crSuccess)}
end;

{Returns a range capability}
function TTwainSource.GetRangeValue(Capability: TW_UINT16;
  var ItemType: TW_UINT16; var Min, Max, Step, Default,
  Current: String; MemHandle: HGLOBAL): TCapabilityRet;
var
  RangeV   : pTW_RANGE;
  Container: TW_UINT16;
begin
  {Call method to get the memory to the return}
  if MemHandle = 0 then
    Result := GetCapabilityRec(Capability, MemHandle, rcGet, Container)
  else
  begin
    Result := crSuccess;
    Container := TWON_RANGE;
  end;

  if (Result = crSuccess) and (Container <> TWON_RANGE) then
  begin
    Result := crInvalidContainer;
    GlobalFree(MemHandle);
    Exit;
  end;

  {If result was sucessfull and memory was allocated}
  if (Result = crSuccess) then
  begin
    {Obtain structure pointer}
    RangeV := GlobalLock(MemHandle);
    {Fill return}
    ItemType := RangeV^.ItemType;
    GetItem(Min, ItemType, @RangeV^.MinValue);
    GetItem(Max, ItemType, @RangeV^.MaxValue);
    GetItem(Step, ItemType, @RangeV^.StepSize);
    GetItem(Default, ItemType, @RangeV^.DefaultValue);
    GetItem(Current, ItemType, @RangeV^.CurrentValue);

    {Unlock memory and unallocate}
    GlobalUnlock(MemHandle);
    GlobalFree(MemHandle);
  end {if (Result = crSuccess)}
end;

{Returns an one value capability}
function TTwainSource.GetOneValue(Capability: TW_UINT16;
  var ItemType: TW_UINT16; var Value: String;
  Mode: TRetrieveCap; MemHandle: HGLOBAL): TCapabilityRet;
var
  OneV     : pTW_ONEVALUE;
  Container: TW_UINT16;
begin
  {Call method to get the memory to the return}
  if MemHandle = 0 then
    Result := GetCapabilityRec(Capability, MemHandle, Mode, Container)
  else
  begin
    Result := crSuccess;
    Container := TWON_ONEVALUE;
  end;

  if (Result = crSuccess) and (Container <> TWON_ONEVALUE) then
  begin
    Result := crInvalidContainer;
    GlobalFree(MemHandle);
    Exit;
  end;

  {If result was sucessfull and memory was allocated}
  if (Result = crSuccess) then
  begin
    {Obtain structure pointer}
    OneV := GlobalLock(MemHandle);
    {Fill return}
    ItemType := OneV^.ItemType;
    GetItem(Value, OneV^.ItemType, @OneV^.Item);

    {Unlock memory and unallocate}
    GlobalUnlock(MemHandle);
    GlobalFree(MemHandle);
  end {if (Result = crSuccess)}
end;

{Sets an one value capability}
function TTwainSource.SetOneValue(Capability: TW_UINT16;
  ItemType: TW_UINT16; Value: Pointer): TCapabilityRet;
var
  Data: HGLOBAL;
  OneV: pTW_ONEVALUE;
  ItemSize,ItemSize2: Integer;
begin
  {Allocate enough memory for the TW_ONEVALUE and obtain pointer}
  ItemSize := TWTypeSize(ItemType);
  //npeter: TW_ONEVALUE minimal size !!!
  //I think to meet the specifications the
  //Item's size must be at least sizeof(TW_UINT32)!
  //when I did it, some mistic errors on some drivers went gone
  if ItemSize<TWTypeSize(TWTY_UINT32) then ItemSize2:=TWTypeSize(TWTY_UINT32) else ItemSize2:=ItemSize;
  Data := GlobalAlloc(GHND, sizeof(OneV^.ItemType) + ItemSize2);
  OneV := GlobalLock(Data);

  {Fill value}
  OneV^.ItemType := ItemType;
  CopyMemory(@OneV^.Item, Value, ItemSize);
  GlobalUnlock(Data);

  {Call method to set}
  Result := SetCapabilityRec(Capability, TWON_ONEVALUE, Data);

  {Unload memory}
  GlobalFree(Data);
end;

{Sets a range capability}
function TTwainSource.SetRangeValue(Capability: TW_UINT16;
  ItemType: TW_UINT16; Min, Max, Step, Current: TW_UINT32): TCapabilityRet;
var
  Data: HGLOBAL;
  RangeV: pTW_RANGE;
begin
  {Allocate enough memory for the TW_RANGE and obtain pointer}
  Data := GlobalAlloc(GHND, sizeof(TW_RANGE));
  RangeV := GlobalLock(Data);

  {Fill value}
  RangeV^.ItemType := ItemType;
  RangeV^.MinValue := Min;
  RangeV^.MaxValue := Max;
  RangeV^.StepSize := Step;
  RangeV^.CurrentValue := Current;
  GlobalUnlock(Data);

  {Call method to set}
  Result := SetCapabilityRec(Capability, TWON_RANGE, Data);

  {Unload memory}
  GlobalFree(Data);
end;

{Sets an array capability}
function TTwainSource.SetArrayValue(Capability: TW_UINT16;
  ItemType: TW_UINT16; List: TSetCapabilityList): TCapabilityRet;
var
  Data: HGLOBAL;
  EnumV: pTW_ENUMERATION;
  i, ItemSize: Integer;
  DataPt: PChar;
begin
  {Allocate enough memory for the TW_ARRAY and obtain pointer}
  ItemSize := TWTypeSize(ItemType);
  Data := GlobalAlloc(GHND, sizeof(TW_ARRAY) + ItemSize * Length(List));
  EnumV := GlobalLock(Data);

  {Fill values}
  EnumV^.ItemType := ItemType;
  EnumV^.NumItems := Length(List);

  {Copy item values}
  DataPt := @EnumV^.ItemList[0];
  for i := Low(List) TO High(List) do
  begin
    {Copy item}
    CopyMemory(DataPt, List[i], ItemSize);
    {Move to next item}
    inc(DataPt, ItemSize);
  end;
  GlobalUnlock(Data);

  {Call method to set}
  Result := SetCapabilityRec(Capability, TWON_ARRAY, Data);

  {Unload memory}
  GlobalFree(Data);
end;

{Sets an enumeration capability}
function TTwainSource.SetEnumerationValue(Capability: TW_UINT16;
  ItemType: TW_UINT16; CurrentIndex: TW_UINT32;
  List: TSetCapabilityList): TCapabilityRet;
var
  Data: HGLOBAL;
  EnumV: pTW_ENUMERATION;
  i, ItemSize: Integer;
  DataPt: PChar;
begin
  {Allocate enough memory for the TW_ENUMERATION and obtain pointer}
  ItemSize := TWTypeSize(ItemType);
  Data := GlobalAlloc(GHND, sizeof(TW_ENUMERATION) + ItemSize * Length(List));
  EnumV := GlobalLock(Data);

  {Fill values}
  EnumV^.ItemType := ItemType;
  EnumV^.NumItems := Length(List);
  EnumV^.CurrentIndex := CurrentIndex;

  {Copy item values}
  DataPt := @EnumV^.ItemList[0];
  for i := Low(List) TO High(List) do
  begin
    {Copy item}
    CopyMemory(DataPt, List[i], ItemSize);
    {Move to next item}
    inc(DataPt, ItemSize);
  end;
  GlobalUnlock(Data);

  {Call method to set}
  Result := SetCapabilityRec(Capability, TWON_ENUMERATION, Data);

  {Unload memory}
  GlobalFree(Data);
end;

{Transfer image memory}
function TTwainSource.TransferImageMemory(var ImageHandle: HBitmap;
  PixelType: TW_INT16): TW_UINT16;
var
  {Memory buffer information from the source}
  Setup  : TW_SETUPMEMXFER;
  {Memory information from the image}
  Xfer   : TW_IMAGEMEMXFER;
  {Image processing variables}
  ImageInfo : Windows.TBitmap;
  Ptr       : pChar;
  LineLength,
  CurLine: Cardinal;
  LinePtr,
  AllocPtr  : pointer;
  DataSize,
  Readed,
  Index    : Cardinal;
  ItemPtr  : pRGBTriple;
  Temp     : Byte;

begin
  {Obtain information on the transference buffers}
  Result := Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_SETUPMEMXFER,
    MSG_GET, @Setup);

  {Get information on the bitmap}
  GetObject(ImageHandle, sizeof(Windows.TBitmap), @ImageInfo);
  LineLength := (((ImageInfo.bmWidth * ImageInfo.bmBitsPixel + 31) div 32) * 4);
  {Get pointer for the last line}
  CurLine := ImageInfo.bmHeight - 1;
  Cardinal(LinePtr) := Cardinal(ImageInfo.bmBits) + LineLength * CurLine;
  Ptr := LinePtr;
  DataSize := 0;

  {Prepare buffer record to transfer}
  Fillchar(Xfer, SizeOf(TW_IMAGEMEMXFER), $FF);
  Xfer.Memory.Flags := TWMF_APPOWNS or TWMF_POINTER;
  Xfer.Memory.Length := Setup.Preferred;
  GetMem(AllocPtr, Setup.Preferred);
  Xfer.Memory.TheMem := AllocPtr;

  {Transfer data until done or cancelled}
  if Result = TWRC_SUCCESS then
    repeat
      {Retrieve another piece of memory to the pointer}
      Xfer.BytesWritten := 0;
      Result := Owner.TwainProc(AppInfo, @Structure, DG_IMAGE,
        DAT_IMAGEMEMXFER, MSG_GET, @Xfer);
      {Test the result}
      {Piece sucessfully transfer, move to next}
      if (Result = TWRC_SUCCESS) or (Result = TWRC_XFERDONE) then
      begin
        {While we have data}
        while Xfer.BytesWritten > 0 do
        begin
          {In case the total bytes received now have more than we}
          {need to complete the line}
          if Xfer.BytesWritten + DataSize > LineLength then
          begin
            Readed := LineLength - DataSize;
            CopyMemory(Ptr, Xfer.Memory.TheMem, LineLength - DataSize);
          end
          else
          {Otherwise, continue completing the line}
          begin
            Readed := Xfer.BytesWritten;
            CopyMemory(Ptr, Xfer.Memory.TheMem, Readed);
          end;

          {Adjust}
          inc(DataSize, Readed); inc(Ptr, Readed);
          dec(Xfer.BytesWritten, Readed);
          Cardinal(Xfer.Memory.TheMem) :=
            Cardinal(Xfer.Memory.TheMem) + Readed; 

          {Reached end of line}
          if DataSize >= LineLength then
          begin
            {Fix RGB to BGR}
            if PixelType = TWPT_RGB then
            begin
              ItemPtr := LinePtr;
              FOR Index := 1 TO ImageInfo.bmWidth DO
              begin
                Temp := ItemPtr^.rgbtRed;
                ItemPtr^.rgbtRed := ItemPtr^.rgbtBlue;
                ItemPtr^.rgbtBlue := Temp;
                inc(ItemPtr);
             end {FOR Index};
            end {if PixelType = TWPT_RGB};

            {Adjust pointers}
            Cardinal(LinePtr) := Cardinal(LinePtr) - LineLength;
            Ptr := LinePtr; dec(CurLine); DataSize := 0;

            {Call event}
            if Assigned(Owner.OnAcquireProgress) then
              Owner.OnAcquireProgress(Self, Self.Index, ImageHandle,
                Cardinal(ImageInfo.bmHeight) - CurLine - 1,
                ImageInfo.bmHeight - 1);

          end {if DataSize >= LineLength}

        end {while Xfer.BytesWritten > 0};


        {Set again pointer to write to}
        Xfer.Memory.TheMem := AllocPtr;
      end {TWRC_SUCCESS};

    until Result <> TWRC_SUCCESS;

  {Free allocated memory}
  FreeMem(AllocPtr, Setup.Preferred);

  {Some error ocurred, free memory and returns}
  if Result <> TWRC_XFERDONE then
    DeleteObject(ImageHandle);
end;

{Prepare image memory transference}
function TTwainSource.PrepareMemXfer(var BitmapHandle: HBitmap;
  var PixelType: TW_INT16): TW_UINT16;
const
  PixelColor: Array[TTwainPixelFlavor] of Array[0..1] of Byte =
   ((0, $FF), ($FF, 00), (0, $FF));
var
  Handle: HGlobal;
  Info: TW_IMAGEINFO;
  Setup: TW_SETUPMEMXFER;
  structsize, index, Size, Blocks: Integer;
  XRes, YRes: Extended;
  Pal   : TW_PALETTE8;
  vUnit : TTwainUnit;
  vUnits: TTwainUnitSet;
  Dib   : pBitmapInfo;
  PixelFlavor: TTwainPixelFlavor;
  PixelFlavors: TTwainPixelFlavorSet;
  DC: HDC;
  Data  : Pointer;
begin
  {First of all, get information on the image being acquired}
  Result := Owner.TwainProc(AppInfo, @Structure, DG_IMAGE, DAT_IMAGEINFO,
    MSG_GET, @Info);
  if Result <> TWRC_SUCCESS then exit;

  {Calculate image size}
  with Info do
    size := ((((ImageWidth * BitsPerPixel + 31) div 32)*4) * info.ImageLength);

  {Obtain image buffer transference sizes}
  Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_SETUPMEMXFER,
    MSG_GET, @Setup);
  blocks := (size div Integer(setup.Preferred));
  size := (blocks + 1) * Integer(setup.Preferred);

  {Prepare new bitmap}
  structsize := size + sizeof(BITMAPINFOHEADER) + 256 * sizeof(RGBQUAD);

  Handle := GlobalAlloc(GHND, StructSize);
  Dib := GlobalLock(Handle);
  Fillchar(Dib^, structsize, #0);
  {Fill image information}
  Dib^.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
  Dib^.bmiHeader.biWidth := info.ImageWidth;
  Dib^.bmiHeader.biHeight := info.ImageLength;
  {Only 1 plane supported}
  Dib^.bmiHeader.biPlanes := 1;
  Dib^.bmiHeader.biBitCount := info.BitsPerPixel;
  {No compression}
  Dib^.bmiHeader.biCompression := BI_RGB;
  Dib^.bmiHeader.biSizeImage := Size;

  {Adjust units}
  XRes := Fix32ToFloat(Info.XResolution);
  YRes := Fix32ToFloat(Info.YResolution);
  GetICapUnits(vUnit, vUnits);
  case vUnit of
    tuInches: begin
      Dib^.bmiHeader.biXPelsPerMeter := Trunc((XRes*2.54)*100);
      Dib^.bmiHeader.biYPelsPerMeter := Trunc((YRes*2.54)*100);
      end;
    tuCentimeters: begin
      Dib^.bmiHeader.biXPelsPerMeter := Trunc(XRes*100);
      Dib^.bmiHeader.biYPelsPerMeter := Trunc(YRes*100);
      end
    else begin
      Dib^.bmiHeader.biXPelsPerMeter := 0;
      Dib^.bmiHeader.biYPelsPerMeter := 0;
    end
  end {case vUnits of};

  {Now it should setup the palette to be used by the image}
  {by either building a definied palette or retrieving the}
  {image's one}
  case (Info.PixelType) of
    TWPT_BW:
    begin
      {Only two colors are used}
      Dib^.bmiHeader.biClrUsed := 2;
      Dib^.bmiHeader.biClrImportant := 0;
      {Try obtaining the pixel flavor}
      if GetIPixelFlavor(PixelFlavor, PixelFlavors) <> crSuccess then
        PixelFlavor := tpfChocolate;
      {Set palette colors}
      for Index := 0 to 1 do
      begin
        Dib^.bmiColors[Index].rgbRed := PixelColor[PixelFlavor][Index];
        Dib^.bmiColors[Index].rgbGreen := PixelColor[PixelFlavor][Index];
        Dib^.bmiColors[Index].rgbBlue := PixelColor[PixelFlavor][Index];
        Dib^.bmiColors[Index].rgbReserved := 0;
      end;

    end;
    TWPT_GRAY:
    begin
      {Creates a 256 shades of gray palette}
      Dib^.bmiHeader.biClrUsed := 256;
      for index := 0 to 255 do
      begin
        Dib^.bmiColors[index].rgbRed := index;
        Dib^.bmiColors[index].rgbGreen := index;
        Dib^.bmiColors[index].rgbBlue := index;
        Dib^.bmiColors[index].rgbReserved := 0;
      end {for i}
    end;
    TWPT_RGB: Dib^.bmiHeader.biClrUsed := 0;
    else
    begin
      {Try obtaining the palette}
      if Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_PALETTE8,
        MSG_GET, @Pal) <> TWRC_SUCCESS then
      begin
        {If the source did not provide a palette, uses shades of gray here}
        Dib^.bmiHeader.biClrUsed := 256;
        for index := 0 to 255 do
        begin
          Dib^.bmiColors[index].rgbRed := index;
          Dib^.bmiColors[index].rgbGreen := index;
          Dib^.bmiColors[index].rgbBlue := index;
          Dib^.bmiColors[index].rgbReserved := 0;
        end {for i}
      end
      else
      begin
        {Uses source palette here}
        Dib^.bmiHeader.biClrUsed := Pal.NumColors;
        for Index := 0 TO Pal.NumColors - 1 do
        begin
          Dib^.bmiColors[index].rgbRed := pal.Colors[index].Channel1;
          Dib^.bmiColors[index].rgbGreen := pal.Colors[index].Channel2;
          Dib^.bmiColors[index].rgbBlue := pal.Colors[index].Channel3;
          Dib^.bmiColors[index].rgbReserved := 0;
        end {for Index}
      end {if Owner.TwainProc(AppInfo...}

    end {case else};
  end {case Info.PixelType};

  {Creates the bitmap}
  DC := GetDC(Owner.VirtualWindow);
  Cardinal(Data) := Cardinal(Dib) + Dib^.bmiHeader.biSize +
    (Dib^.bmiHeader.biClrUsed * sizeof(RGBQUAD));
  BitmapHandle := CreateDIBSection(DC, Dib^, DIB_RGB_COLORS, Data, 0, 0);
  ReleaseDC(Owner.VirtualWindow, DC);
  PixelType := Info.PixelType;

  {Unlock and free data}
  GlobalUnlock(Handle);
  GlobalFree(Handle);
end;

{Method to transfer the images}
procedure TTwainSource.TransferImages();
var
  {To test if the image transfer is done}
  Cancel, Done   : Boolean;
  {Return code from Twain method}
  rc     : TW_UINT16;
  {Handle to the native Device independent Image (DIB)}
  hNative: TW_UINT32;
  {Pending transfers structure}
  PendingXfers: TW_PENDINGXFERS;
  {File transfer info}
  Info: TW_SETUPFILEXFER;
  {Image handle and pointer}
  ImageHandle: HBitmap;
  PixelType  : TW_INT16;
begin
  {Set the transfer mode}
  //npeter:
  //on a HP driver I got error events
  //when it was set above state 5;
  //commented out
  // ChangeTransferMode(TransferMode);

  Cancel := FALSE; {Testing if it was cancelled}
  Done := FALSE;  {Initialize done variable}

  {Obtain all the images from the source}
  repeat
    {Transfer depending on the transfer mode}
    case TransferMode of
      {Native transfer, the source creates the image thru a device}
      {dependent image}
      ttmNative:
      begin
        {Call method to obtain the image}
        hNative := 0;
        rc := Owner.TwainProc(AppInfo, @Structure, DG_IMAGE,
          DAT_IMAGENATIVEXFER, MSG_GET, @hNative);
      end {case ttmNative};
      {File transfering, the source should create a file with}
      {the acquired image}
      ttmFile:
      begin
        {Event to allow user to set the file transfer information}
        if Assigned(Owner.OnSourceSetupFileXfer) then
          Owner.OnSourceSetupFileXfer(Owner, Index);
        Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_SETUPFILEXFER,
          MSG_GET, @Info);
        {Call method to make source acquire and create file}
        rc := Owner.TwainProc(AppInfo, @Structure, DG_IMAGE,
          DAT_IMAGEFILEXFER, MSG_GET, nil);
      end {case ttmFile};
      {Memory buffer transfers}
      ttmMemory:
      begin
        {Prepare for memory transference}
        rc := PrepareMemXfer(ImageHandle, PixelType);
        {If the image was sucessfully prepared to be transfered, it's}
        {now time to transfer it}
        if rc = TWRC_SUCCESS then rc := TransferImageMemory(ImageHandle,
          PixelType);
      end
      {Unknown transfer mode ?}
      else Rc := 0;
    end;

    {Twain call to transfer image return}
    case rc of
      {Transfer sucessfully done}
      TWRC_XFERDONE:
        case TransferMode of
          {Native transfer sucessfull}
          ttmNative: ReadNative(hNative, Cancel);
          {File transfer sucessfull}
          ttmFile: ReadFile(Info.FileName, Info.Format, Cancel);
          {Memory transfer sucessfull}
          ttmMemory: ReadMemory(ImageHandle, Cancel);
        end {case TransferMode, TWRC_XFERDONE};
      {User cancelled the transfers}
      TWRC_CANCEL:
      begin
        {Acknowledge end of transfer}
        Done := TRUE;
        {Call event, if avaliable}
        if Assigned(Owner.OnAcquireCancel) then
          Owner.OnAcquireCancel(Owner, Index)
      end
      else {Unknown return or error}
        if Assigned(Owner.OnAcquireError) then
          Owner.OnAcquireError(Owner, Index, Rc, GetReturnStatus())
    end;

    {Check if there are pending transfers}
    if not Done then
      Done := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL,
        DAT_PENDINGXFERS, MSG_ENDXFER, @PendingXfers) <> TWRC_SUCCESS) or
        (PendingXfers.Count = 0);

    {If user has cancelled}
    if not Done and Cancel then
      Done := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL,
        DAT_PENDINGXFERS, MSG_RESET, @PendingXfers) = TWRC_SUCCESS);

  until Done;

  {Disable source}
  Enabled := False;
end;

{Returns the number of colors in the DIB}
function DibNumColors (pv: Pointer): Word;
var
  Bits: Integer;
  lpbi: PBITMAPINFOHEADER absolute pv;
  lpbc: PBITMAPCOREHEADER absolute pv;
begin
  //With the BITMAPINFO format headers, the size of the palette
  //is in biClrUsed, whereas in the BITMAPCORE - style headers, it
  //is dependent on the bits per pixel ( = 2 raised to the power of
  //bits/pixel).
  if (lpbi^.biSize <> sizeof(BITMAPCOREHEADER)) then
  begin
    if (lpbi^.biClrUsed <> 0) then
    begin
      result := lpbi^.biClrUsed;
      exit;
    end;
    Bits := lpbi^.biBitCount;
  end
  else
     Bits := lpbc^.bcBitCount;

  {Test bits to return}
  case (Bits) of
    1: Result := 2;
    4: Result := 16;
    8: Result := 256;
    else Result := 0;
  end {case};

end;

{Converts from TWain TW_UINT16 to TTwainFormat}
function TwainToTTwainFormat(Value: TW_UINT16): TTwainFormat;
begin
  Case Value of
    TWFF_TIFF     : Result := tfTIFF;
    TWFF_PICT     : Result := tfPict;
    TWFF_BMP      : Result := tfBMP;
    TWFF_XBM      : Result := tfXBM;
    TWFF_JFIF     : Result := tfJPEG;
    TWFF_FPX      : Result := tfFPX;
    TWFF_TIFFMULTI: Result := tfTIFFMulti;
    TWFF_PNG      : Result := tfPNG;
    TWFF_SPIFF    : Result := tfSPIFF;
    TWFF_EXIF     : Result := tfEXIF;
    else            Result := tfUnknown;
  end {case Value of}
end;

{Reads the file image}
procedure TTwainSource.ReadFile(Name: TW_STR255; Format: TW_UINT16;
  var Cancel: Boolean);
begin
  {Call event, if set}
  if Assigned(Owner.OnSourceFileTransfer) then
    Owner.OnSourceFileTransfer(Self, Index, Name, TwainToTTwainFormat(Format),
      Cancel);
end;

{Call event for memory image}
procedure TTwainSource.ReadMemory(Image: HBitmap; var Cancel: Boolean);
{$IFNDEF DONTUSEVCL} var BitmapObj: TBitmap;{$ENDIF}
begin

  if Assigned(Owner.OnTwainAcquire) then
  {$IFDEF DONTUSEVCL}
  Owner.OnTwainAcquire(Owner, Index, Image, Cancel); {$ELSE}
  begin
    BitmapObj := TBitmap.Create;
    BitmapObj.Handle := Image;
    Owner.OnTwainAcquire(Owner, Index, BitmapObj, Cancel);
    BitmapObj.Free;
  end; {$ENDIF}
end;

{Reads a native image}
procedure TTwainSource.ReadNative(Handle: TW_UINT32; var Cancel: Boolean);
var
  DibInfo: ^TBITMAPINFO;
  ColorTableSize: Integer;
  lpBits: PChar;
  DC: HDC;
  BitmapHandle: HBitmap;
  {$IFNDEF DONTUSEVCL}BitmapObj: TBitmap;{$ENDIF}
begin

  {Get image information pointer and size}
  DibInfo := GlobalLock(Handle);
  ColorTableSize := (DibNumColors(DibInfo) * SizeOf(RGBQUAD));

  {Get data memory position}
  lpBits := PChar(DibInfo);
  Inc(lpBits, DibInfo.bmiHeader.biSize);
  Inc(lpBits, ColorTableSize);

  {Creates the bitmap}
  DC := GetDC(Owner.VirtualWindow);
  BitmapHandle := CreateDIBitmap(DC, DibInfo.bmiHeader, CBM_INIT,
     lpBits, DibInfo^, DIB_RGB_COLORS);
  ReleaseDC(Owner.VirtualWindow, DC);

  if Assigned(Owner.OnTwainAcquire) then
  {$IFDEF DONTUSEVCL}
  Owner.OnTwainAcquire(Owner, Index, BitmapHandle, Cancel); {$ELSE}
  begin
    BitmapObj := TBitmap.Create;
    BitmapObj.Handle := BitmapHandle;
    Owner.OnTwainAcquire(Owner, Index, BitmapObj, Cancel);
    BitmapObj.Free;
  end; {$ENDIF}

  {Free bitmap}
  GlobalUnlock(Handle);
  GlobalFree(Handle);
end;

{Setup file transfer}
function TTwainSource.SetupFileTransfer(Filename: String;
  Format: TTwainFormat): Boolean;
const
  FormatToTwain: Array[TTwainFormat] of TW_UINT16 = (TWFF_TIFF,
    TWFF_PICT, TWFF_BMP, TWFF_XBM, TWFF_JFIF, TWFF_FPX, TWFF_TIFFMULTI,
    TWFF_PNG, TWFF_SPIFF, TWFF_EXIF, 0);
var
  FileTransferInfo: TW_SETUPFILEXFER;
begin
  {Source must be loaded to set things}
  if (Loaded) then
  begin
    {Prepare structure}
    FileTransferInfo.FileName := StrToStr255(FileName);
    FileTransferInfo.Format := FormatToTwain[Format];

    {Call method}
    Result := (Owner.TwainProc(AppInfo, @Structure, DG_CONTROL,
      DAT_SETUPFILEXFER, MSG_SET, @FileTransferInfo) = TWRC_SUCCESS);
  end
  else Result := FALSE;  {Could not set file transfer with source unloaded}
end;

{Set the number of images that the application wants to receive}
function TTwainSource.SetCapXferCount(Value: SmallInt): TCapabilityRet;
begin
  {Call method to set the value}
  Result := SetOneValue(CAP_XFERCOUNT, TWTY_UINT16, @Value);
end;

{Returns the number of images that the source will return}
function TTwainSource.GetCapXferCount(var Return: SmallInt;
  Mode: TRetrieveCap): TCapabilityRet;
var
  {Will hold the capability information}
  ItemType: TW_UINT16;
  Value   : String;
begin
  {Call method to return information}
  Result := GetOneValue(CAP_XFERCOUNT, ItemType, Value, Mode);
  {Item type must be of TW_UINT16}
  if (Result = crSuccess) and (ItemType <> TWTY_INT16) then
    Result := crUnsupported;
  {If everything gone ok, fill result}
  if Result = crSuccess then Return := StrToIntDef(Value, -1);
end;

{Set the unit measure}
function TTwainSource.SetICapUnits(Value: TTwainUnit): TCapabilityRet;
//npeter
//the TTwainUnit is byte!!!
//so we have to convert it to TW_UINT16
//before this fix I was not able to set this capability
//on a HP driver
const Transfer: Array[TTwainUnit] of TW_UINT16 =
       (TWUN_INCHES, TWUN_CENTIMETERS, TWUN_PICAS, TWUN_POINTS, TWUN_TWIPS, TWUN_PIXELS, TWUN_INCHES);
var
  iValue: TW_UINT16;
begin
  ivalue:=Transfer[Value];
  Result := SetOneValue(ICAP_UNITS, TWTY_UINT16, @iValue);
end;

{Convert from Twain to TTwainPixelFlavor}
function TwainToTTwainPixelFlavor(Value: TW_UINT16): TTwainPixelFlavor;
begin
  {Test the value to make the convertion}
  case Value of
    TWPF_CHOCOLATE: Result := tpfChocolate;
    TWPF_VANILLA  : Result := tpfVanilla;
  else Result := tpfUnknown;
  end {case Value}
end;

{Convert from Twain to TTwainUnit}
function TwainToTTwainUnit(Value: TW_UINT16): TTwainUnit;
begin
  {Test the value to make the convertion}
  case Value of
    TWUN_INCHES     : Result := tuInches;
    TWUN_CENTIMETERS: Result := tuCentimeters;
    TWUN_PICAS      : Result := tuPicas;
    TWUN_POINTS     : Result := tuPoints;
    TWUN_TWIPS      : Result := tuTwips;
    TWUN_PIXELS     : Result := tuPixels;
  else Result := tuUnknown;
  end {case Value}
end;

{Retrieve the unit measure for all quantities}
function TTwainSource.GetICapUnits(var Return: TTwainUnit;
  var Supported: TTwainUnitSet; Mode: TRetrieveCap): TCapabilityRet;
var
  ItemType: TW_UINT16;
  List    : TGetCapabilityList;
  Current, i,
  Default : Integer;
begin
  {Call method to get result}
  Result := GetEnumerationValue(ICAP_UNITS, ItemType, List, Current, Default,
    Mode);
  if ItemType <> TWTY_UINT16 then Result := crUnsupported;

  {If it was sucessfull, return values}
  if Result = crSuccess then
  begin
    {Make list}
    for i := Low(List) to High(List) do
      Include(Supported, TwainToTTwainUnit(StrToIntDef(List[i], -1)));
    {Return values depending on the mode}
    if Mode = rcGetDefault then
      Return := TwainToTTwainUnit(StrToIntDef(List[Default], -1))
    else
      Return := TwainToTTwainUnit(StrToIntDef(List[Current], -1));
  end {if Result = crSuccess}

end;

{Retrieve the pixel flavor values}
function TTwainSource.GetIPixelFlavor(var Return: TTwainPixelFlavor;
  var Supported: TTwainPixelFlavorSet; Mode: TRetrieveCap): TCapabilityRet;
var
  ItemType: TW_UINT16;
  List    : TGetCapabilityList;
  Current, i,
  Default : Integer;
begin
  {Call method to get result}
  Result := GetEnumerationValue(ICAP_PIXELFLAVOR, ItemType, List, Current,
    Default, Mode);
  if ItemType <> TWTY_UINT16 then Result := crUnsupported;

  {If it was sucessfull, return values}
  if Result = crSuccess then
  begin
    {Make list}
    for i := Low(List) to High(List) do
      Include(Supported, TwainToTTwainPixelFlavor(StrToIntDef(List[i], -1)));
    {Return values depending on the mode}
    if Mode = rcGetDefault then
      Return := TwainToTTwainPixelFlavor(StrToIntDef(List[Default], -1))
    else
      Return := TwainToTTwainPixelFlavor(StrToIntDef(List[Current], -1));
  end {if Result = crSuccess}
end;

function TTwainSource.SetIPixelFlavor(Value: TTwainPixelFlavor): TCapabilityRet;
//npeter
//the TTwainPixelFlavor is byte!!!
//so we have to convert it to TW_UINT16
//before this fix I was not able to set this capability
//on a HP driver
const Transfer: array [TTwainPixelFlavor] of TW_UINT16 = (TWPF_CHOCOLATE,TWPF_VANILLA,TWPF_CHOCOLATE);
var iValue: TW_UINT16;
begin
  iValue:=Transfer[value];
  Result := SetOneValue(ICAP_PIXELFLAVOR, TWTY_UINT16, @iValue);
end;

{Convert from Twain to TTwainPixelType}
function TwainToTTwainPixelType(Value: TW_UINT16): TTwainPixelType;
begin
  {Test the value to make the convertion}
  case Value of
    TWPT_BW         : Result := tbdBw;
    TWPT_GRAY       : Result := tbdGray;
    TWPT_RGB        : Result := tbdRgb;
    TWPT_PALETTE    : Result := tbdPalette;
    TWPT_CMY        : Result := tbdCmy;
    TWPT_CMYK       : Result := tbdCmyk;
    TWPT_YUV        : Result := tbdYuv;
    TWPT_YUVK       : Result := tbdYuvk;
    TWPT_CIEXYZ     : Result := tbdCieXYZ;
  else Result := tbdUnknown;
  end {case Value}
end;

{Returns pixel type values}
function TTwainSource.GetIPixelType(var Return: TTwainPixelType;
  var Supported: TTwainPixelTypeSet; Mode: TRetrieveCap): TCapabilityRet;
var
  ItemType: TW_UINT16;
  List    : TGetCapabilityList;
  Current, i,
  Default : Integer;
begin
  {Call method to get result}
  Result := GetEnumerationValue(ICAP_PIXELTYPE, ItemType, List, Current,
    Default, Mode);
  if ItemType <> TWTY_UINT16 then Result := crUnsupported;

  {If it was sucessfull, return values}
  if Result = crSuccess then
  begin
    {Make list}
    for i := Low(List) to High(List) do
      Include(Supported, TwainToTTwainPixelType(StrToIntDef(List[i], -1)));
    {Return values depending on the mode}
    if Mode = rcGetDefault then
      Return := TwainToTTwainPixelType(StrToIntDef(List[Default], -1))
    else
      Return := TwainToTTwainPixelType(StrToIntDef(List[Current], -1));
  end {if Result = crSuccess}
end;

{Set the pixel type value}
function TTwainSource.SetIPixelType(Value: TTwainPixelType): TCapabilityRet;
//npeter
//the TTwainPixelType is byte!!!
//so we have to convert it to TW_UINT16
//before this fix occasionally I was not able to set this capability
//on a HP driver
var ivalue: smallint;
begin
 ivalue:=ord(value);
 Result := SetOneValue(ICAP_PIXELTYPE, TWTY_UINT16, @iValue);
end;

{Returns bitdepth values}
function TTwainSource.GetIBitDepth(var Return: Word;
  var Supported: TTwainBitDepth; Mode: TRetrieveCap): TCapabilityRet;
var
  ItemType: TW_UINT16;
  List    : TGetCapabilityList;
  Current, i,
  Default : Integer;
begin
  {Call GetOneValue to obtain this property}
  Result := GetEnumerationValue(ICAP_BITDEPTH, ItemType, List, Current,
    Default, Mode);
  if ItemType <> TWTY_UINT16 then Result := crUnsupported;

  {In case everything went ok, fill parameters}
  if Result = crSuccess then
  begin
    {Build bit depth list}
    SetLength(Supported, Length(List));
    FOR i := LOW(List) TO HIGH(List) DO
      Supported[i] := StrToIntDef(List[i], -1);
    {Return values depending on the mode}
    if Mode = rcGetDefault then Return := StrToIntDef(List[Default], -1)
    else Return := StrToIntDef(List[Current], -1);
  end {if Result = crSuccess}
end;

{Set current bitdepth value}
function TTwainSource.SetIBitDepth(Value: Word): TCapabilityRet;
begin
  Result := SetOneValue(ICAP_BITDEPTH, TWTY_UINT16, @Value);
end;

{Returns physical width}
function TTwainSource.GetIPhysicalWidth(var Return: Extended;
  Mode: TRetrieveCap): TCapabilityRet;
var
  Handle: HGlobal;
  OneV  : pTW_ONEVALUE;
  Container: TW_UINT16;
begin
  {Obtain handle to data from this capability}
  Result := GetCapabilityRec(ICAP_PHYSICALWIDTH, Handle, Mode, Container);
  if Result = crSuccess then
  begin
    {Obtain data}
    OneV := GlobalLock(Handle);
    if OneV^.ItemType <> TWTY_FIX32 then Result := crUnsupported
    else Return := Fix32ToFloat(pTW_FIX32(@OneV^.Item)^);
    {Free data}
    GlobalUnlock(Handle);
    GlobalFree(Handle);
  end;
end;

{Returns physical height}
function TTwainSource.GetIPhysicalHeight(var Return: Extended;
  Mode: TRetrieveCap): TCapabilityRet;
var
  Handle: HGlobal;
  OneV  : pTW_ONEVALUE;
  Container: TW_UINT16;
begin
  {Obtain handle to data from this capability}
  Result := GetCapabilityRec(ICAP_PHYSICALHEIGHT, Handle, Mode, Container);
  if Result = crSuccess then
  begin
    {Obtain data}
    OneV := GlobalLock(Handle);
    if OneV^.ItemType <> TWTY_FIX32 then Result := crUnsupported
    else Return := Fix32ToFloat(pTW_FIX32(@OneV^.Item)^);
    {Free data}
    GlobalUnlock(Handle);
    GlobalFree(Handle);
  end;
end;

{Returns a resolution}
function TTwainSource.GetResolution(Capability: TW_UINT16; var Return: Extended;
  var Values: TTwainResolution; Mode: TRetrieveCap): TCapabilityRet;
var
  Handle: HGlobal;
  EnumV:  pTW_ENUMERATION;
  Container: TW_UINT16;
  Item: pTW_FIX32;
  i   : Integer;
begin
  {Obtain handle to data from this capability}
  Result := GetCapabilityRec(Capability, Handle, Mode, Container);
  if Result = crSuccess then
  begin
    {Obtain data}
    //npeter
    //the "if" is just for sure!
    if (Container<>TWON_ENUMERATION) and (Container<>TWON_ARRAY) then
     begin
      result:=crUnsupported;
      exit;
     end;

    EnumV := GlobalLock(Handle);
    if EnumV^.ItemType <> TWTY_FIX32 then Result := crUnsupported
    else begin
      {Set array size and pointer to the first item}
      Item := @EnumV^.ItemList[0];
      SetLength(Values, EnumV^.NumItems);
      {Fill array}
      FOR i := 1 TO EnumV^.NumItems DO
      begin
        {Fill array with the item}
        Values[i - 1] := Fix32ToFloat(Item^);
        {Move to next item}
        inc(Item);
      end {FOR i};

      {Fill return}

      //npeter
      //DefaultIndex and CurrentIndex valid for enum only!
      //I got nice AV with an old Mustek scanner which uses TWON_ARRAY
      //i return 0 in this case (may be not the best solution, but not AV at least :-)
      if (Container<>TWON_ARRAY) then
       begin
        if Mode = rcGetDefault then Return := Values[EnumV^.DefaultIndex]
        else Return := Values[EnumV^.CurrentIndex];
       end
      else return:=0;
    end;
    {Free data}
    GlobalUnlock(Handle);
    GlobalFree(Handle);
  end;
end;

{Sets X resolution}
function TTwainSource.SetIXResolution(Value: Extended): TCapabilityRet;
var
  Fix32: TW_FIX32;
begin
  Fix32 := FloatToFix32(Value);
  Result := SetOneValue(ICAP_XRESOLUTION, TWTY_FIX32, @Fix32);
end;

{Sets Y resolution}
function TTwainSource.SetIYResolution(Value: Extended): TCapabilityRet;
var
  Fix32: TW_FIX32;
begin
  Fix32 := FloatToFix32(Value);
  Result := SetOneValue(ICAP_YRESOLUTION, TWTY_FIX32, @Fix32);
end;

{Returns X resolution}
function TTwainSource.GetIXResolution(var Return: Extended;
  var Values: TTwainResolution; Mode: TRetrieveCap): TCapabilityRet;
begin
  Result := GetResolution(ICAP_XRESOLUTION, Return, Values, Mode);
end;

{Returns Y resolution}
function TTwainSource.GetIYResolution(var Return: Extended;
  var Values: TTwainResolution; Mode: TRetrieveCap): TCapabilityRet;
begin
  Result := GetResolution(ICAP_YRESOLUTION, Return, Values, Mode);
end;

{Returns if user interface is controllable}
function TTwainSource.GetUIControllable(var Return: Boolean): TCapabilityRet;
var
  ItemType: TW_UINT16;
  Value   : String;
begin
  {Try to obtain value and make sure it is of type TW_BOOL}
  Result := GetOneValue(CAP_UICONTROLLABLE, ItemType, Value, rcGet);
  if (Result = crSuccess) and (ItemType <> TWTY_BOOL) then
    Result := crUnsupported;
  {Return value, by checked the return value from GetOneValue}
  if Result = crSuccess then Return := (Value = '1');
end;

{Returns if feeder is loaded}
function TTwainSource.GetFeederLoaded(var Return: Boolean): TCapabilityRet;
var
  ItemType: TW_UINT16;
  Value   : String;
begin
  {Try to obtain value and make sure it is of type TW_BOOL}
  Result := GetOneValue(CAP_FEEDERLOADED, ItemType, Value, rcGet);
  if (Result = crSuccess) and (ItemType <> TWTY_BOOL) then
    Result := crUnsupported;
  {Return value, by checked the return value from GetOneValue}
  if Result = crSuccess then Return := (Value = '1');
end;

{Returns if feeder is enabled}
function TTwainSource.GetFeederEnabled(var Return: Boolean): TCapabilityRet;
var
  ItemType: TW_UINT16;
  Value   : String;
begin
  {Try to obtain value and make sure it is of type TW_BOOL}
  Result := GetOneValue(CAP_FEEDERENABLED, ItemType, Value, rcGet);
  if (Result = crSuccess) and (ItemType <> TWTY_BOOL) then
    Result := crUnsupported;
  {Return value, by checked the return value from GetOneValue}
  if Result = crSuccess then Return := (Value = '1');
end;

{Set if feeder is enabled}
function TTwainSource.SetFeederEnabled(Value: WordBool): TCapabilityRet;
begin
  {Call SetOneValue to set value}
  Result := SetOneValue(CAP_FEEDERENABLED, TWTY_BOOL, @Value);
end;


{Returns if autofeed is enabled}
function TTwainSource.GetAutofeed(var Return: Boolean): TCapabilityRet;
var
  ItemType: TW_UINT16;
  Value   : String;
begin
  {Try to obtain value and make sure it is of type TW_BOOL}
  Result := GetOneValue(CAP_AUTOFEED, ItemType, Value, rcGet);
  if (Result = crSuccess) and (ItemType <> TWTY_BOOL) then
    Result := crUnsupported;
  {Return value, by checked the return value from GetOneValue}
  if Result = crSuccess then Return := (Value = '1');
end;

{Set if autofeed is enabled}
function TTwainSource.SetAutoFeed(Value: WordBool): TCapabilityRet;
begin
  {Call SetOneValue to set value}
  Result := SetOneValue(CAP_AUTOFEED, TWTY_BOOL, @Value);
end;


{Used with property PendingXfers}
function TTwainSource.GetPendingXfers: TW_INT16;
var
  PendingXfers: TW_PENDINGXFERS;
begin
  if Loaded and Enabled then
  begin
    {Call method to retrieve}
    if Owner.TwainProc(AppInfo, @Structure, DG_CONTROL, DAT_PENDINGXFERS,
      MSG_GET, @PendingXfers) = TWRC_SUCCESS then
      Result := PendingXfers.Count
    else Result := ERROR_INT16; {Some error ocurred while calling message}
  end
  else Result := ERROR_INT16;  {Source not loaded/enabled}
end;

{Returns a TMsg structure}
function MakeMsg(const Handle: THandle; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): TMsg;
begin
  {Fill structure with the parameters}
  Result.hwnd := Handle;
  Result.message := uMsg;
  Result.wParam := wParam;
  Result.lParam := lParam;
  GetCursorPos(Result.pt);
end;

{Virtual window procedure handler}
function VirtualWinProc(Handle: THandle; uMsg: UINT; wParam: WPARAM;
  lParam: LPARAM): LResult; stdcall;

  {Returns the TDelphiTwain object}
  function Obj: TDelphiTwain;
  begin
    Longint(Result) := GetWindowLong(Handle, GWL_USERDATA);
  end {function};

var
  Twain: TDelphiTwain;
  i    : Integer;
  Msg  : TMsg;
begin
  {Tests for the message}
  case uMsg of
    {Creation of the window}
    WM_CREATE:
      {Stores the TDelphiTwain object handle}
      with pCreateStruct(lParam)^ do
        SetWindowLong(Handle, GWL_USERDATA, Longint(lpCreateParams));
    {case} else
    begin
      {Try to obtain the current object pointer}
      Twain := Obj;

      if Assigned(Twain) then
        {If there are sources loaded, we need to verify}
        {this message}
       if (Twain.SourcesLoaded > 0) then
        begin
          {Convert parameters to a TMsg}
          Msg := MakeMsg(Handle, uMsg, wParam, lParam);
          {Tell about this message}
          FOR i := 0 TO Twain.SourceCount - 1 DO
            if ((Twain.Source[i].Loaded) and (Twain.Source[i].Enabled)) then
              if Twain.Source[i].ProcessMessage(Msg) then
              begin
                {Case this was a message from the source, there is}
                {no need for the default procedure to process}
                Result := 0;
                Exit;
              end;

        end {if (Twain.SourcesLoaded > 0)}


    end {case Else}
  end {case uMsg of};

  {Calls method to handle}
  Result := DefWindowProc(Handle, uMsg, wParam, lParam);
end;


//npeter: 2004.01.12
//sets the acquired area
function TTwainSource.SetImagelayoutFrame(const fLeft, fTop, fRight,
  fBottom: double): TCapabilityRet;
var ImageLayout: TW_IMAGELAYOUT;
begin
 if not Loaded then
  begin
   Result := crInvalidState;  {In case the source is not loaded}
   exit;
  end;

 fillchar(ImageLayout,sizeof(TW_IMAGELAYOUT),0);
 with ImageLayout.Frame do
  begin
   Left:=FloatToFIX32(fLeft);
   Top:=FloatToFIX32(fTop);
   Right:=FloatToFIX32(fRight);
   Bottom:=FloatToFIX32(fBottom);
  end;
 {Call method and store return}
 Result := ResultToCapabilityRec(Owner.TwainProc(AppInfo, @Structure,
      DG_IMAGE, DAT_IMAGELAYOUT, MSG_SET, @ImageLayout));
end;

//npeter: 2004.01.12
//enable/disable progress indicators
function TTwainSource.SetIndicators(Value: boolean): TCapabilityRet;
begin
  {Call SetOneValue to set value}
  Result := SetOneValue(CAP_INDICATORS, TWTY_BOOL, @Value);
end;


{Information for the virtual window class}
var
  VirtualWinClass: TWNDClass;


initialization
  {Registers the virtual window class}
  VirtualWinClass.hInstance := hInstance;
  VirtualWinClass.style := 0;
  VirtualWinClass.lpfnWndProc := @VirtualWinProc;
  VirtualWinClass.cbClsExtra := 0;
  VirtualWinClass.cbWndExtra := 0;
  VirtualWinClass.hIcon := 0;
  VirtualWinClass.hCursor := 0;
  VirtualWinClass.hbrBackground := COLOR_WINDOW + 1;
  VirtualWinClass.lpszMenuName := '';
  VirtualWinClass.lpszClassName := VIRTUALWIN_CLASSNAME;
  Windows.RegisterClass(VirtualWinClass);
finalization
  {Unregisters the virtual window class}
  Windows.UnregisterClass(VIRTUALWIN_CLASSNAME, hInstance);
end.