2863 lines
90 KiB
Plaintext
2863 lines
90 KiB
Plaintext
{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) + decimalseparator + IntToStr(Frac);
|
|
{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.
|