2011. május 12., csütörtök

Do you want TWAIN?


Problem/Question/Abstract:

Do you want TWAIN?

Answer:

////////////////////////////////////////////////////////////////////////
//                                                                    //
//               Delphi Scanner Support Framework                     //
//                                                                    //
//               Copyright (C) 1999 by Uli Tessel                     //
//                                                                    //
////////////////////////////////////////////////////////////////////////
//                                                                    //
//         Modified and rewritten as a Delphi component by:           //
//                                                                    //
//                           M. de Haan                               //
//                                                                    //
//                           June 2002                                //
//                                                                    //
////////////////////////////////////////////////////////////////////////

unit
  TWAIN;

interface

uses
  SysUtils, // Exceptions
  Forms, // TMessageEvent
  Windows, // HMODULE
  Graphics, // TBitmap
  IniFiles, // Inifile
  Controls, // TCursor
  Classes; // Class

const
  // Messages
  MSG_GET = $0001; // Get one or more values
  MSG_GETCURRENT = $0002; // Get current value
  MSG_GETDEFAULT = $0003; // Get default (e.g. power up) value
  MSG_GETFIRST = $0004; // Get first of a series of items,
  // e.g. Data Sources
  MSG_GETNEXT = $0005; // Iterate through a series of items
  MSG_SET = $0006; // Set one or more values
  MSG_RESET = $0007; // Set current value to default value
  MSG_QUERYSUPPORT = $0008; // Get supported operations on the
  // capacities

// Messages used with DAT_NULL
// ---------------------------
  MSG_XFERREADY = $0101; // The data source has data ready
  MSG_CLOSEDSREQ = $0102; // Request for the application to close
  // the Data Source
  MSG_CLOSEDSOK = $0103; // Tell the application to save the
  // state
  MSG_DEVICEEVENT = $0104; // Some event has taken place

  // Messages used with a pointer to a DAT_STATUS structure
  // ------------------------------------------------------
  MSG_CHECKSTATUS = $0201; // Get status information

  // Messages used with a pointer to DAT_PARENT data
  // -----------------------------------------------
  MSG_OPENDSM = $0301; // Open the Data Source Manager
  MSG_CLOSEDSM = $0302; // Close the Data Source Manager

  // Messages used with a pointer to a DAT_IDENTITY structure
  // --------------------------------------------------------
  MSG_OPENDS = $0401; // Open a Data Source
  MSG_CLOSEDS = $0402; // Close a Data Source
  MSG_USERSELECT = $0403; // Put up a dialog of all Data Sources
  // The user can select a Data Source

// Messages used with a pointer to a DAT_USERINTERFACE structure
// -------------------------------------------------------------
  MSG_DISABLEDS = $0501; // Disable data transfer in the Data
  // Source
  MSG_ENABLEDS = $0502; // Enable data transfer in the Data
  // Source
  MSG_ENABLEDSUIONLY = $0503; // Enable for saving Data Source state
  // only

// Messages used with a pointer to a DAT_EVENT structure
// -----------------------------------------------------
  MSG_PROCESSEVENT = $0601;

  // Messages used with a pointer to a DAT_PENDINGXFERS structure
  // ------------------------------------------------------------
  MSG_ENDXFER = $0701;
  MSG_STOPFEEDER = $0702;

  // Messages used with a pointer to a DAT_FILESYSTEM structure
  // ----------------------------------------------------------
  MSG_CHANGEDIRECTORY = $0801;
  MSG_CREATEDIRECTORY = $0802;
  MSG_DELETE = $0803;
  MSG_FORMATMEDIA = $0804;
  MSG_GETCLOSE = $0805;
  MSG_GETFIRSTFILE = $0806;
  MSG_GETINFO = $0807;
  MSG_GETNEXTFILE = $0808;
  MSG_RENAME = $0809;
  MSG_COPY = $080A;
  MSG_AUTOMATICCAPTUREDIRECTORY = $080B;

  // Messages used with a pointer to a DAT_PASSTHRU structure
  // --------------------------------------------------------
  MSG_PASSTHRU = $0901;

const
  DG_CONTROL = $0001; // data pertaining to control
  DG_IMAGE = $0002; // data pertaining to raster images

const
  // Data Argument Types for the DG_CONTROL Data Group.
  DAT_CAPABILITY = $0001; // TW_CAPABILITY
  DAT_EVENT = $0002; // TW_EVENT
  DAT_IDENTITY = $0003; // TW_IDENTITY
  DAT_PARENT = $0004; // TW_HANDLE,
  // application win handle in Windows
  DAT_PENDINGXFERS = $0005; // TW_PENDINGXFERS
  DAT_SETUPMEMXFER = $0006; // TW_SETUPMEMXFER
  DAT_SETUPFILEXFER = $0007; // TW_SETUPFILEXFER
  DAT_STATUS = $0008; // TW_STATUS
  DAT_USERINTERFACE = $0009; // TW_USERINTERFACE
  DAT_XFERGROUP = $000A; // TW_UINT32
  DAT_IMAGEMEMXFER = $0103; // TW_IMAGEMEMXFER
  DAT_IMAGENATIVEXFER = $0104; // TW_UINT32, loword is hDIB, PICHandle
  DAT_IMAGEFILEXFER = $0105; // Null data

const
  // Condition Codes: Application gets these by doing DG_CONTROL
  // DAT_STATUS MSG_GET.
  TWCC_CUSTOMBASE = $8000;
  TWCC_SUCCESS = 00; // It worked!
  TWCC_BUMMER = 01; // Failure due to unknown causes
  TWCC_LOWMEMORY = 02; // Not enough memory to perform operation
  TWCC_NODS = 03; // No Data Source
  TWCC_MAXCONNECTIONS = 04; // Data Source is connected to maximum
  // number of possible applications
  TWCC_OPERATIONERROR = 05; // Data Source or Data Source Manager
  // reported error, application
  // shouldn't report an error
  TWCC_BADCAP = 06; // Unknown capability
  TWCC_BADPROTOCOL = 09; // Unrecognized MSG DG DAT combination
  TWCC_BADVALUE = 10; // Data parameter out of range
  TWCC_SEQERROR = 11; // DG DAT MSG out of expected sequence
  TWCC_BADDEST = 12; // Unknown destination Application /
  // Source in DSM_Entry
  TWCC_CAPUNSUPPORTED = 13; // Capability not supported by source
  TWCC_CAPBADOPERATION = 14; // Operation not supported by
  // capability
  TWCC_CAPSEQERROR = 15; // Capability has dependancy on other
  // capability
  TWCC_DENIED = 16; // File System operation is denied
  // (file is protected)
  TWCC_FILEEXISTS = 17; // Operation failed because file
  // already exists
  TWCC_FILENOTFOUND = 18; // File not found
  TWCC_NOTEMPTY = 19; // Operation failed because directory
  // is not empty
  TWCC_PAPERJAM = 20; // The feeder is jammed
  TWCC_PAPERDOUBLEFEED = 21; // The feeder detected multiple pages
  TWCC_FILEWRITEERROR = 22; // Error writing the file (meant for
  // things like disk full conditions)
  TWCC_CHECKDEVICEONLINE = 23; // The device went offline prior to or
  // during this operation

const
  // Flags used in TW_MEMORY structure
  TWMF_APPOWNS = $01;
  TWMF_DSMOWNS = $02;
  TWMF_DSOWNS = $04;
  TWMF_POINTER = $08;
  TWMF_HANDLE = $10;

const
  // Flags for country, which seems to be equal to their telephone
  // number
  TWCY_AFGHANISTAN = 1001;
  TWCY_ALGERIA = 0213;
  TWCY_AMERICANSAMOA = 0684;
  TWCY_ANDORRA = 0033;
  TWCY_ANGOLA = 1002;
  TWCY_ANGUILLA = 8090;
  TWCY_ANTIGUA = 8091;
  TWCY_ARGENTINA = 0054;
  TWCY_ARUBA = 0297;
  TWCY_ASCENSIONI = 0247;
  TWCY_AUSTRALIA = 0061;
  TWCY_AUSTRIA = 0043;
  TWCY_BAHAMAS = 8092;
  TWCY_BAHRAIN = 0973;
  TWCY_BANGLADESH = 0880;
  TWCY_BARBADOS = 8093;
  TWCY_BELGIUM = 0032;
  TWCY_BELIZE = 0501;
  TWCY_BENIN = 0229;
  TWCY_BERMUDA = 8094;
  TWCY_BHUTAN = 1003;
  TWCY_BOLIVIA = 0591;
  TWCY_BOTSWANA = 0267;
  TWCY_BRITAIN = 0006;
  TWCY_BRITVIRGINIS = 8095;
  TWCY_BRAZIL = 0055;
  TWCY_BRUNEI = 0673;
  TWCY_BULGARIA = 0359;
  TWCY_BURKINAFASO = 1004;
  TWCY_BURMA = 1005;
  TWCY_BURUNDI = 1006;
  TWCY_CAMAROON = 0237;
  TWCY_CANADA = 0002;
  TWCY_CAPEVERDEIS = 0238;
  TWCY_CAYMANIS = 8096;
  TWCY_CENTRALAFREP = 1007;
  TWCY_CHAD = 1008;
  TWCY_CHILE = 0056;
  TWCY_CHINA = 0086;
  TWCY_CHRISTMASIS = 1009;
  TWCY_COCOSIS = 1009;
  TWCY_COLOMBIA = 0057;
  TWCY_COMOROS = 1010;
  TWCY_CONGO = 1011;
  TWCY_COOKIS = 1012;
  TWCY_COSTARICA = 0506;
  TWCY_CUBA = 0005;
  TWCY_CYPRUS = 0357;
  TWCY_CZECHOSLOVAKIA = 0042;
  TWCY_DENMARK = 0045;
  TWCY_DJIBOUTI = 1013;
  TWCY_DOMINICA = 8097;
  TWCY_DOMINCANREP = 8098;
  TWCY_EASTERIS = 1014;
  TWCY_ECUADOR = 0593;
  TWCY_EGYPT = 0020;
  TWCY_ELSALVADOR = 0503;
  TWCY_EQGUINEA = 1015;
  TWCY_ETHIOPIA = 0251;
  TWCY_FALKLANDIS = 1016;
  TWCY_FAEROEIS = 0298;
  TWCY_FIJIISLANDS = 0679;
  TWCY_FINLAND = 0358;
  TWCY_FRANCE = 0033;
  TWCY_FRANTILLES = 0596;
  TWCY_FRGUIANA = 0594;
  TWCY_FRPOLYNEISA = 0689;
  TWCY_FUTANAIS = 1043;
  TWCY_GABON = 0241;
  TWCY_GAMBIA = 0220;
  TWCY_GERMANY = 0049;
  TWCY_GHANA = 0233;
  TWCY_GIBRALTER = 0350;
  TWCY_GREECE = 0030;
  TWCY_GREENLAND = 0299;
  TWCY_GRENADA = 8099;
  TWCY_GRENEDINES = 8015;
  TWCY_GUADELOUPE = 0590;
  TWCY_GUAM = 0671;
  TWCY_GUANTANAMOBAY = 5399;
  TWCY_GUATEMALA = 0502;
  TWCY_GUINEA = 0224;
  TWCY_GUINEABISSAU = 1017;
  TWCY_GUYANA = 0592;
  TWCY_HAITI = 0509;
  TWCY_HONDURAS = 0504;
  TWCY_HONGKONG = 0852;
  TWCY_HUNGARY = 0036;
  TWCY_ICELAND = 0354;
  TWCY_INDIA = 0091;
  TWCY_INDONESIA = 0062;
  TWCY_IRAN = 0098;
  TWCY_IRAQ = 0964;
  TWCY_IRELAND = 0353;
  TWCY_ISRAEL = 0972;
  TWCY_ITALY = 0039;
  TWCY_IVORYCOAST = 0225;
  TWCY_JAMAICA = 8010;
  TWCY_JAPAN = 0081;
  TWCY_JORDAN = 0962;
  TWCY_KENYA = 0254;
  TWCY_KIRIBATI = 1018;
  TWCY_KOREA = 0082;
  TWCY_KUWAIT = 0965;
  TWCY_LAOS = 1019;
  TWCY_LEBANON = 1020;
  TWCY_LIBERIA = 0231;
  TWCY_LIBYA = 0218;
  TWCY_LIECHTENSTEIN = 0041;
  TWCY_LUXENBOURG = 0352;
  TWCY_MACAO = 0853;
  TWCY_MADAGASCAR = 1021;
  TWCY_MALAWI = 0265;
  TWCY_MALAYSIA = 0060;
  TWCY_MALDIVES = 0960;
  TWCY_MALI = 1022;
  TWCY_MALTA = 0356;
  TWCY_MARSHALLIS = 0692;
  TWCY_MAURITANIA = 1023;
  TWCY_MAURITIUS = 0230;
  TWCY_MEXICO = 0003;
  TWCY_MICRONESIA = 0691;
  TWCY_MIQUELON = 0508;
  TWCY_MONACO = 0033;
  TWCY_MONGOLIA = 1024;
  TWCY_MONTSERRAT = 8011;
  TWCY_MOROCCO = 0212;
  TWCY_MOZAMBIQUE = 1025;
  TWCY_NAMIBIA = 0264;
  TWCY_NAURU = 1026;
  TWCY_NEPAL = 0977;
  TWCY_NETHERLANDS = 0031;
  TWCY_NETHANTILLES = 0599;
  TWCY_NEVIS = 8012;
  TWCY_NEWCALEDONIA = 0687;
  TWCY_NEWZEALAND = 0064;
  TWCY_NICARAGUA = 0505;
  TWCY_NIGER = 0227;
  TWCY_NIGERIA = 0234;
  TWCY_NIUE = 1027;
  TWCY_NORFOLKI = 1028;
  TWCY_NORWAY = 0047;
  TWCY_OMAN = 0968;
  TWCY_PAKISTAN = 0092;
  TWCY_PALAU = 1029;
  TWCY_PANAMA = 0507;
  TWCY_PARAGUAY = 0595;
  TWCY_PERU = 0051;
  TWCY_PHILLIPPINES = 0063;
  TWCY_PITCAIRNIS = 1030;
  TWCY_PNEWGUINEA = 0675;
  TWCY_POLAND = 0048;
  TWCY_PORTUGAL = 0351;
  TWCY_QATAR = 0974;
  TWCY_REUNIONI = 1031;
  TWCY_ROMANIA = 0040;
  TWCY_RWANDA = 0250;
  TWCY_SAIPAN = 0670;
  TWCY_SANMARINO = 0039;
  TWCY_SAOTOME = 1033;
  TWCY_SAUDIARABIA = 0966;
  TWCY_SENEGAL = 0221;
  TWCY_SEYCHELLESIS = 1034;
  TWCY_SIERRALEONE = 1035;
  TWCY_SINGAPORE = 0065;
  TWCY_SOLOMONIS = 1036;
  TWCY_SOMALI = 1037;
  TWCY_SOUTHAFRICA = 0027;
  TWCY_SPAIN = 0034;
  TWCY_SRILANKA = 0094;
  TWCY_STHELENA = 1032;
  TWCY_STKITTS = 8013;
  TWCY_STLUCIA = 8014;
  TWCY_STPIERRE = 0508;
  TWCY_STVINCENT = 8015;
  TWCY_SUDAN = 1038;
  TWCY_SURINAME = 0597;
  TWCY_SWAZILAND = 0268;
  TWCY_SWEDEN = 0046;
  TWCY_SWITZERLAND = 0041;
  TWCY_SYRIA = 1039;
  TWCY_TAIWAN = 0886;
  TWCY_TANZANIA = 0255;
  TWCY_THAILAND = 0066;
  TWCY_TOBAGO = 8016;
  TWCY_TOGO = 0228;
  TWCY_TONGAIS = 0676;
  TWCY_TRINIDAD = 8016;
  TWCY_TUNISIA = 0216;
  TWCY_TURKEY = 0090;
  TWCY_TURKSCAICOS = 8017;
  TWCY_TUVALU = 1040;
  TWCY_UGANDA = 0256;
  TWCY_USSR = 0007;
  TWCY_UAEMIRATES = 0971;
  TWCY_UNITEDKINGDOM = 0044;
  TWCY_USA = 0001;
  TWCY_URUGUAY = 0598;
  TWCY_VANUATU = 1041;
  TWCY_VATICANCITY = 0039;
  TWCY_VENEZUELA = 0058;
  TWCY_WAKE = 1042;
  TWCY_WALLISIS = 1043;
  TWCY_WESTERNSAHARA = 1044;
  TWCY_WESTERNSAMOA = 1045;
  TWCY_YEMEN = 1046;
  TWCY_YUGOSLAVIA = 0038;
  TWCY_ZAIRE = 0243;
  TWCY_ZAMBIA = 0260;
  TWCY_ZIMBABWE = 0263;
  TWCY_ALBANIA = 0355;
  TWCY_ARMENIA = 0374;
  TWCY_AZERBAIJAN = 0994;
  TWCY_BELARUS = 0375;
  TWCY_BOSNIAHERZGO = 0387;
  TWCY_CAMBODIA = 0855;
  TWCY_CROATIA = 0385;
  TWCY_CZECHREPUBLIC = 0420;
  TWCY_DIEGOGARCIA = 0246;
  TWCY_ERITREA = 0291;
  TWCY_ESTONIA = 0372;
  TWCY_GEORGIA = 0995;
  TWCY_LATVIA = 0371;
  TWCY_LESOTHO = 0266;
  TWCY_LITHUANIA = 0370;
  TWCY_MACEDONIA = 0389;
  TWCY_MAYOTTEIS = 0269;
  TWCY_MOLDOVA = 0373;
  TWCY_MYANMAR = 0095;
  TWCY_NORTHKOREA = 0850;
  TWCY_PUERTORICO = 0787;
  TWCY_RUSSIA = 0007;
  TWCY_SERBIA = 0381;
  TWCY_SLOVAKIA = 0421;
  TWCY_SLOVENIA = 0386;
  TWCY_SOUTHKOREA = 0082;
  TWCY_UKRAINE = 0380;
  TWCY_USVIRGINIS = 0340;
  TWCY_VIETNAM = 0084;

const
  // Flags for languages
  TWLG_DAN = 000; // Danish
  TWLG_DUT = 001; // Dutch
  TWLG_ENG = 002; // English
  TWLG_FCF = 003; // French Canadian
  TWLG_FIN = 004; // Finnish
  TWLG_FRN = 005; // French
  TWLG_GER = 006; // German
  TWLG_ICE = 007; // Icelandic
  TWLG_ITN = 008; // Italian
  TWLG_NOR = 009; // Norwegian
  TWLG_POR = 010; // Portuguese
  TWLG_SPA = 011; // Spannish
  TWLG_SWE = 012; // Swedish
  TWLG_USA = 013;
  TWLG_AFRIKAANS = 014;
  TWLG_ALBANIA = 015;
  TWLG_ARABIC = 016;
  TWLG_ARABIC_ALGERIA = 017;
  TWLG_ARABIC_BAHRAIN = 018;
  TWLG_ARABIC_EGYPT = 019;
  TWLG_ARABIC_IRAQ = 020;
  TWLG_ARABIC_JORDAN = 021;
  TWLG_ARABIC_KUWAIT = 022;
  TWLG_ARABIC_LEBANON = 023;
  TWLG_ARABIC_LIBYA = 024;
  TWLG_ARABIC_MOROCCO = 025;
  TWLG_ARABIC_OMAN = 026;
  TWLG_ARABIC_QATAR = 027;
  TWLG_ARABIC_SAUDIARABIA = 028;
  TWLG_ARABIC_SYRIA = 029;
  TWLG_ARABIC_TUNISIA = 030;
  TWLG_ARABIC_UAE = 031; // United Arabic Emirates
  TWLG_ARABIC_YEMEN = 032;
  TWLG_BASQUE = 033;
  TWLG_BYELORUSSIAN = 034;
  TWLG_BULGARIAN = 035;
  TWLG_CATALAN = 036;
  TWLG_CHINESE = 037;
  TWLG_CHINESE_HONGKONG = 038;
  TWLG_CHINESE_PRC = 039; // People's Republic of China
  TWLG_CHINESE_SINGAPORE = 040;
  TWLG_CHINESE_SIMPLIFIED = 041;
  TWLG_CHINESE_TAIWAN = 042;
  TWLG_CHINESE_TRADITIONAL = 043;
  TWLG_CROATIA = 044;
  TWLG_CZECH = 045;
  TWLG_DANISH = TWLG_DAN;
  TWLG_DUTCH = TWLG_DUT;
  TWLG_DUTCH_BELGIAN = 046;
  TWLG_ENGLISH = TWLG_ENG;
  TWLG_ENGLISH_AUSTRALIAN = 047;
  TWLG_ENGLISH_CANADIAN = 048;
  TWLG_ENGLISH_IRELAND = 049;
  TWLG_ENGLISH_NEWZEALAND = 050;
  TWLG_ENGLISH_SOUTHAFRICA = 051;
  TWLG_ENGLISH_UK = 052;
  TWLG_ENGLISH_USA = TWLG_USA;
  TWLG_ESTONIAN = 053;
  TWLG_FAEROESE = 054;
  TWLG_FARSI = 055;
  TWLG_FINNISH = TWLG_FIN;
  TWLG_FRENCH = TWLG_FRN;
  TWLG_FRENCH_BELGIAN = 056;
  TWLG_FRENCH_CANADIAN = TWLG_FCF;
  TWLG_FRENCH_LUXEMBOURG = 057;
  TWLG_FRENCH_SWISS = 058;
  TWLG_GERMAN = TWLG_GER;
  TWLG_GERMAN_AUSTRIAN = 059;
  TWLG_GERMAN_LUXEMBOURG = 060;
  TWLG_GERMAN_LIECHTENSTEIN = 061;
  TWLG_GERMAN_SWISS = 062;
  TWLG_GREEK = 063;
  TWLG_HEBREW = 064;
  TWLG_HUNGARIAN = 065;
  TWLG_ICELANDIC = TWLG_ICE;
  TWLG_INDONESIAN = 066;
  TWLG_ITALIAN = TWLG_ITN;
  TWLG_ITALIAN_SWISS = 067;
  TWLG_JAPANESE = 068;
  TWLG_KOREAN = 069;
  TWLG_KOREAN_JOHAB = 070;
  TWLG_LATVIAN = 071;
  TWLG_LITHUANIAN = 072;
  TWLG_NORWEGIAN = TWLG_NOR;
  TWLG_NORWEGIAN_BOKMAL = 073;
  TWLG_NORWEGIAN_NYNORSK = 074;
  TWLG_POLISH = 075;
  TWLG_PORTUGUESE = TWLG_POR;
  TWLG_PORTUGUESE_BRAZIL = 076;
  TWLG_ROMANIAN = 077;
  TWLG_RUSSIAN = 078;
  TWLG_SERBIAN_LATIN = 079;
  TWLG_SLOVAK = 080;
  TWLG_SLOVENIAN = 081;
  TWLG_SPANISH = TWLG_SPA;
  TWLG_SPANISH_MEXICAN = 082;
  TWLG_SPANISH_MODERN = 083;
  TWLG_SWEDISH = TWLG_SWE;
  TWLG_THAI = 084;
  TWLG_TURKISH = 085;
  TWLG_UKRANIAN = 086;
  TWLG_ASSAMESE = 087;
  TWLG_BENGALI = 088;
  TWLG_BIHARI = 089;
  TWLG_BODO = 090;
  TWLG_DOGRI = 091;
  TWLG_GUJARATI = 092;
  TWLG_HARYANVI = 093;
  TWLG_HINDI = 094;
  TWLG_KANNADA = 095;
  TWLG_KASHMIRI = 096;
  TWLG_MALAYALAM = 097;
  TWLG_MARATHI = 098;
  TWLG_MARWARI = 099;
  TWLG_MEGHALAYAN = 100;
  TWLG_MIZO = 101;
  TWLG_NAGA = 102;
  TWLG_ORISSI = 103;
  TWLG_PUNJABI = 104;
  TWLG_PUSHTU = 105;
  TWLG_SERBIAN_CYRILLIC = 106;
  TWLG_SIKKIMI = 107;
  TWLG_SWEDISH_FINLAND = 108;
  TWLG_TAMIL = 109;
  TWLG_TELUGU = 110;
  TWLG_TRIPURI = 111;
  TWLG_URDU = 112;
  TWLG_VIETNAMESE = 113;

const
  TWRC_SUCCESS = 0;
  TWRC_FAILURE = 1; // Application may get TW_STATUS for
  // info on failure
  TWRC_CHECKSTATUS = 2; // tried hard to get the status
  TWRC_CANCEL = 3;
  TWRC_DSEVENT = 4;
  TWRC_NOTDSEVENT = 5;
  TWRC_XFERDONE = 6;
  TWRC_ENDOFLIST = 7; // After MSG_GETNEXT if nothing left
  TWRC_INFONOTSUPPORTED = 8;
  TWRC_DATANOTAVAILABLE = 9;

const
  TWON_ONEVALUE = $05; // indicates TW_ONEVALUE container
  TWON_DONTCARE8 = $FF;

const
  ICAP_XFERMECH = $0103;

const
  TWTY_UINT16 = $0004; // Means: item is a TW_UINT16

const
  // ICAP_XFERMECH values (SX_ means Setup XFer)
  TWSX_NATIVE = 0;
  TWSX_FILE = 1;
  TWSX_MEMORY = 2;
  TWSX_FILE2 = 3;

type
  TW_UINT16 = WORD; // unsigned short TW_UINT16
  pTW_UINT16 = ^TW_UINT16;
  TTWUInt16 = TW_UINT16;
  PTWUInt16 = pTW_UINT16;

type
  TW_BOOL = WORDBOOL; // unsigned short TW_BOOL
  pTW_BOOL = ^TW_BOOL;
  TTWBool = TW_BOOL;
  PTWBool = pTW_BOOL;

type
  TW_STR32 = array[0..33] of Char; // char TW_STR32[34]
  pTW_STR32 = ^TW_STR32;
  TTWStr32 = TW_STR32;
  PTWStr32 = pTW_STR32;

type
  TW_STR255 = array[0..255] of Char; // char TW_STR255[256]
  pTW_STR255 = ^TW_STR255;
  TTWStr255 = TW_STR255;
  PTWStr255 = pTW_STR255;

type
  TW_INT16 = SmallInt; // short TW_INT16
  pTW_INT16 = ^TW_INT16;
  TTWInt16 = TW_INT16;
  PTWInt16 = pTW_INT16;

type
  TW_UINT32 = ULONG; // unsigned long TW_UINT32
  pTW_UINT32 = ^TW_UINT32;
  TTWUInt32 = TW_UINT32;
  PTWUInt32 = pTW_UINT32;

type
  TW_HANDLE = THandle;
  TTWHandle = TW_HANDLE;
  TW_MEMREF = Pointer;
  TTWMemRef = TW_MEMREF;

type
  // DAT_PENDINGXFERS. Used with MSG_ENDXFER to indicate additional
  // data
  TW_PENDINGXFERS = packed record
    Count: TW_UINT16;
    case Boolean of
      False: (EOJ: TW_UINT32);
      True: (Reserved: TW_UINT32);
  end;
  pTW_PENDINGXFERS = ^TW_PENDINGXFERS;
  TTWPendingXFERS = TW_PENDINGXFERS;
  PTWPendingXFERS = pTW_PENDINGXFERS;

type
  // DAT_EVENT. For passing events down from the application to the DS
  TW_EVENT = packed record
    pEvent: TW_MEMREF; // Windows pMSG or Mac pEvent.
    TWMessage: TW_UINT16; // TW msg from data source, e.g.
    // MSG_XFERREADY
  end;
  pTW_EVENT = ^TW_EVENT;
  TTWEvent = TW_EVENT;
  PTWEvent = pTW_EVENT;

type
  // TWON_ONEVALUE. Container for one value
  TW_ONEVALUE = packed record
    ItemType: TW_UINT16;
    Item: TW_UINT32;
  end;
  pTW_ONEVALUE = ^TW_ONEVALUE;
  TTWOneValue = TW_ONEVALUE;
  PTWOneValue = pTW_ONEVALUE;

type
  // DAT_CAPABILITY. Used by application to get/set capability from/in
  // a data source.
  TW_CAPABILITY = packed record
    Cap: TW_UINT16; // id of capability to set or get, e.g.
    // CAP_BRIGHTNESS
    ConType: TW_UINT16; // TWON_ONEVALUE, _RANGE, _ENUMERATION or
    // _ARRAY
    hContainer: TW_HANDLE; // Handle to container of type Dat
  end;
  pTW_CAPABILITY = ^TW_CAPABILITY;
  TTWCapability = TW_CAPABILITY;
  PTWCapability = pTW_CAPABILITY;

type
  // DAT_STATUS. Application gets detailed status info from a data
  // source with this
  TW_STATUS = packed record
    ConditionCode: TW_UINT16; // Any TWCC_xxx constant
    Reserved: TW_UINT16; // Future expansion space
  end;
  pTW_STATUS = ^TW_STATUS;
  TTWStatus = TW_STATUS;
  PTWStatus = pTW_STATUS;

type
  // No DAT needed. Used to manage memory buffers
  TW_MEMORY = packed record
    Flags: TW_UINT32; // Any combination of the TWMF_ constants
    Length: TW_UINT32; // Number of bytes stored in buffer TheMem
    TheMem: TW_MEMREF; // Pointer or handle to the allocated memory
    // buffer
  end;
  pTW_MEMORY = ^TW_MEMORY;
  TTWMemory = TW_MEMORY;
  PTWMemory = pTW_MEMORY;

const
  // ICAP_IMAGEFILEFORMAT values (FF_means File Format
  TWFF_TIFF = 0; // Tagged Image File Format
  TWFF_PICT = 1; // Macintosh PICT
  TWFF_BMP = 2; // Windows Bitmap
  TWFF_XBM = 3; // X-Windows Bitmap
  TWFF_JFIF = 4; // JPEG File Interchange Format
  TWFF_FPX = 5; // Flash Pix
  TWFF_TIFFMULTI = 6; // Multi-page tiff file
  TWFF_PNG = 7; // Portable Network Graphic
  TWFF_SPIFF = 8;
  TWFF_EXIF = 9;

type
  // DAT_SETUPFILEXFER. Sets up DS to application data transfer via a
  // file
  TW_SETUPFILEXFER = packed record
    FileName: TW_STR255;
    Format: TW_UINT16; // Any TWFF_xxx constant
    VRefNum: TW_INT16; // Used for Mac only
  end;
  pTW_SETUPFILEXFER = ^TW_SETUPFILEXFER;
  TTWSetupFileXFER = TW_SETUPFILEXFER;
  PTWSetupFileXFER = pTW_SETUPFILEXFER;

type
  // DAT_SETUPFILEXFER2. Sets up DS to application data transfer via a
  // file. }
  TW_SETUPFILEXFER2 = packed record
    FileName: TW_MEMREF; // Pointer to file name text
    FileNameType: TW_UINT16; // TWTY_STR1024 or TWTY_UNI512
    Format: TW_UINT16; // Any TWFF_xxx constant
    VRefNum: TW_INT16; // Used for Mac only
    parID: TW_UINT32; // Used for Mac only
  end;
  pTW_SETUPFILEXFER2 = ^TW_SETUPFILEXFER2;
  TTWSetupFileXFER2 = TW_SETUPFILEXFER2;
  PTWSetupFileXFER2 = pTW_SETUPFILEXFER2;

type
  // DAT_SETUPMEMXFER. Sets up Data Source to application data
  // transfer via a memory buffer
  TW_SETUPMEMXFER = packed record
    MinBufSize: TW_UINT32;
    MaxBufSize: TW_UINT32;
    Preferred: TW_UINT32;
  end;
  pTW_SETUPMEMXFER = ^TW_SETUPMEMXFER;
  TTWSetupMemXFER = TW_SETUPMEMXFER;
  PTWSetupMemXFER = pTW_SETUPMEMXFER;

type
  TW_VERSION = packed record
    MajorNum: TW_UINT16; // Major revision number of the software.
    MinorNum: TW_UINT16; // Incremental revision number of the
    // software
    Language: TW_UINT16; // e.g. TWLG_SWISSFRENCH
    Country: TW_UINT16; // e.g. TWCY_SWITZERLAND
    Info: TW_STR32; // e.g. "1.0b3 Beta release"
  end;
  pTW_VERSION = ^TW_VERSION;
  PTWVersion = pTW_VERSION;
  TTWVersion = TW_VERSION;

type
  TW_IDENTITY = packed record
    Id: TW_UINT32; // Unique number. In Windows,
    // application hWnd
    Version: TW_VERSION; // Identifies the piece of code
    ProtocolMajor: TW_UINT16; // Application and DS must set to
    // TWON_PROTOCOLMAJOR
    ProtocolMinor: TW_UINT16; // Application and DS must set to
    // TWON_PROTOCOLMINOR
    SupportedGroups: TW_UINT32; // Bit field OR combination of DG_
    // constants
    Manufacturer: TW_STR32; // Manufacturer name, e.g.
    // "Hewlett-Packard"
    ProductFamily: TW_STR32; // Product family name, e.g.
    // "ScanJet"
    ProductName: TW_STR32; // Product name, e.g. "ScanJet Plus"
  end;
  pTW_IDENTITY = ^TW_IDENTITY;

type
  // DAT_USERINTERFACE. Coordinates UI between application and data
  // source
  TW_USERINTERFACE = packed record
    ShowUI: TW_BOOL; // TRUE if DS should bring up its UI
    ModalUI: TW_BOOL; // For Mac only - true if the DS's UI is modal
    hParent: TW_HANDLE; // For Windows only - Application handle
  end;
  pTW_USERINTERFACE = ^TW_USERINTERFACE;
  TTWUserInterface = TW_USERINTERFACE;
  PTWUserInterface = pTW_USERINTERFACE;

  ////////////////////////////////////////////////////////////////////////
  //                                                                    //
  //                END OF TWAIN TYPES AND CONSTANTS                    //
  //                                                                    //
  ////////////////////////////////////////////////////////////////////////

const
  TWAIN_DLL_Name = 'TWAIN_32.DLL';
  DSM_Entry_Name = 'DSM_Entry';
  Ini_File_Name = 'WIN.INI';
  CrLf = #13 + #10;

resourcestring // Errorstrings:
  ERR_DSM_ENTRY_NOT_FOUND = 'Unable to find the entry of the Data ' +
    'Source Manager in: TWAIN_32.DLL';
  ERR_TWAIN_NOT_LOADED = 'Unable to load or find: TWAIN_32.DLL';
  ERR_DSM_CALL_FAILED = 'A call to the Data Source Manager failed ' +
    'in module %s';
  ERR_UNKNOWN = 'A call to the Data Source Manager failed ' +
    'in module %s: Code %.04x';
  ERR_DSM_OPEN = 'Unable to close the Data Source Manager. ' +
    'Maybe a source is still in use';
  ERR_STATUS = 'Unable to get the status';
  ERR_DSM = 'Data Source Manager error in module %s:' +
    CrLf + '%s';
  ERR_DS = 'Data Source error in module %s:' +
    CrLf + '%s';

type
  ETwainError = class(Exception);
  TImageType = (ffTIFF, ffPICT, ffBMP, ffXBM, ffJFIF, ffFPX,
    ffTIFFMULTI, ffPNG, ffSPIFF, ffEXIF, ffUNKNOWN);
  TTransferType = (xfNative, xfMemory, xfFile);
  TLanguageType = (lgDutch, lgEnglish,
    lgFrench, lgGerman,
    lgAmerican, lgItalian,
    lgSpanish, lgNorwegian,
    lgFinnish, lgDanish,
    lgRussian, lgPortuguese,
    lgSwedish, lgPolish,
    lgGreek, lgTurkish);
  TCountryType = (ctNetherlands, ctEngland,
    ctFrance, ctGermany,
    ctUSA, ctSpain,
    ctItaly, ctDenmark,
    ctFinland, ctNorway,
    ctRussia, ctPortugal,
    ctSweden, ctPoland,
    ctGreece, ctTurkey);
  TTWAIN = class(TComponent)
  private
    // Private declarations
    fBitmap: TBitmap; // the actual bmp used for
    // scanning, must be
    // removed
    HDSMDLL: HMODULE; // = 0, the library handle:
    // will stay global
    appId: TW_IDENTITY; // our (Application) ID.
    // (may stay global)
    dsId: TW_IDENTITY; // Data Source ID (will
    // become member of DS
    // class)
    fhWnd: HWND; // = 0, maybe will be
    // removed, use
    // application.handle
    // instead
    fXfer: TTransferType; // = xfNative;
    bDataSourceManagerOpen: Boolean; // = False, flag, may stay
    // global
    bDataSourceOpen: Boolean; // = False, will become
    // member of DS class
    bDataSourceEnabled: Boolean; // = False, will become
    // member of DS class
    fScanReady: TNotifyEvent; // notifies that the scan
    // is ready
    sDefaultSource: string; // remember old data source
    fOldOnMessageHandler: TMessageEvent; // Save old OnMessage event
    fShowUI: Boolean; // Show User Interface
    fSetupFileXfer: TW_SETUPFILEXFER; // Not used yet
    fSetupMemoryXfer: TW_SETUPMEMXFER; // Not used yet
    fMemory: TW_MEMORY; // Not used yet

    function fLoadTwain: Boolean;
    procedure fUnloadTwain;
    function fNativeXfer: Boolean;
    function fMemoryXfer: Boolean; // Not used yet
    function fFileXfer: Boolean; // Not used yet
    function fGetDestination: TTransferType;
    procedure fSetDestination(dest: TTransferType);
    function Condition2String(ConditionCode: TW_UINT16): string;
    procedure RaiseLastDataSourceManagerCondition(module: string);
    procedure RaiseLastDataSourceCondition(module: string);
    procedure TwainCheckDataSourceManager(res: TW_UINT16;
      module: string);
    procedure TwainCheckDataSource(res: TW_UINT16;
      module: string);

    function CallDataSourceManager(pOrigin: pTW_IDENTITY;
      DG: TW_UINT32;
      DAT: TW_UINT16;
      MSG: TW_UINT16;
      pData: TW_MEMREF): TW_UINT16;

    function CallDataSource(DG: TW_UINT32;
      DAT: TW_UINT16;
      MSG: TW_UINT16;
      pData: TW_MEMREF): TW_UINT16;

    procedure XferMech;
    procedure fSetProductname(pn: string);
    function fGetProductname: string;
    procedure fSetManufacturer(mf: string);
    function fGetManufacturer: string;
    procedure fSetProductFamily(pf: string);
    function fGetProductFamily: string;
    procedure fSetLanguage(lg: TLanguageType);
    function fGetLanguage: TLanguageType;
    procedure fSetCountry(ct: TCountryType);
    function fGetCountry: TCountryType;
    procedure SaveDefaultSourceEntry;
    procedure RestoreDefaultSourceEntry;
    procedure fSetCursor(cr: TCursor);
    function fGetCursor: TCursor;
    procedure fSetImageType(it: TImageType);
    function fGetImageType: TImageType;
    procedure fSetFilename(fn: string);
    function fGetFilename: string;
    procedure fSetVersionInfo(vi: string);
    function fGetVersionInfo: string;
    procedure fSetVersionMajor(vmaj: WORD);
    procedure fSetVersionMinor(vmin: WORD);
    function fGetVersionMajor: WORD;
    function fGetVersionMinor: WORD;

  protected
    procedure ScanReady; dynamic; // Notifies when image transfer is
    // ready
    procedure fNewOnMessageHandler(var Msg: TMsg;
      var Handled: Boolean); virtual;

  public
    // Public declarations
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Acquire(aBmp: TBitmap);
    procedure OpenDataSource;
    procedure CloseDataSource;
    procedure InitTWAIN;
    procedure OpenDataSourceManager;
    procedure CloseDataSourceManager;
    function IsDataSourceManagerOpen: Boolean;
    procedure EnableDataSource;
    // Procedure TWEnableDSUIOnly(ShowUI : Boolean);
    procedure DisableDataSource;
    function IsDataSourceOpen: Boolean;
    function IsDataSourceEnabled: Boolean;
    procedure SelectDataSource;
    function IsTwainDriverAvailable: Boolean;
    function ProcessSourceMessage(var Msg: TMsg): Boolean;

  published
    // Published declarations
    // Properties, methods
    property Destination: TTransferType
      read fGetDestination write fSetDestination;
    property TwainDriverFound: Boolean
      read IsTwainDriverAvailable;
    property Productname: string
      read fGetProductname write fSetProductname;
    property Manufacturer: string
      read fGetManufacturer write fSetManufacturer;
    property ProductFamily: string
      read fGetProductFamily write fSetProductFamily;
    property Language: TLanguageType
      read fGetLanguage write fSetLanguage;
    property Country: TCountryType
      read fGetCountry write fSetCountry;
    property ShowUI: Boolean
      read fShowUI write fShowUI;
    property Cursor: TCursor
      read fGetCursor write fSetCursor;
    property FileFormat: TImageType
      read fGetImageType write fSetImageType;
    property Filename: string
      read fGetFilename write fSetFilename;
    property VersionInfo: string
      read fGetVersionInfo write fSetVersionInfo;
    property VersionMajor: WORD
      read fGetVersionMajor write fSetVersionMajor;
    property VersionMinor: WORD
      read fGetVersionMinor write fSetVersionMinor;
    // Events
    property OnScanReady: TNotifyEvent
      read fScanReady write fScanReady;
  end;

procedure Register;

type
  DSMENTRYPROC = function(pOrigin: pTW_IDENTITY;
    pDest: pTW_IDENTITY;
    DG: TW_UINT32;
    DAT: TW_UINT16;
    MSG: TW_UINT16;
    pData: TW_MEMREF): TW_UINT16; stdcall;
  TDSMEntryProc = DSMENTRYPROC;

type
  DSENTRYPROC = function(pOrigin: pTW_IDENTITY;
    DG: TW_UINT32;
    DAT: TW_UINT16;
    MSG: TW_UINT16;
    pData: TW_MEMREF): TW_UINT16; stdcall;
  TDSEntryProc = DSENTRYPROC;

var
  DS_Entry: TDSEntryProc = nil; // Initialize
  DSM_Entry: TDSMEntryProc = nil; // Initialize

implementation

//---------------------------------------------------------------------

constructor TTWAIN.Create(AOwner: TComponent);

begin
  inherited Create(AOwner);
  // Initialize variables
  appID.Version.Info := 'Twain component';
  appID.Version.Country := TWCY_USA;
  appID.Version.Language := TWLG_USA;
  appID.Productname := 'SimpelSoft TWAIN module'; // This is the one that you are
  // going to see in the UI
  appID.ManuFacturer := 'SimpelSoft';
  appID.ProductFamily := 'SimpelSoft components';
  appID.Version.MajorNum := 1;
  appID.Version.MinorNum := 0;
  // appID.ID := Application.Handle;

  fSetFilename('C:\TWAIN.BMP');
  // fSetupFileXfer.FileName := 'C:\TWAIN.TMP':
  fSetImageType(ffBMP);
  // fSetupFileXfer.Format := TWFF_BMP;
  // fSetupFileXfer.VRefNum := xx; // For Mac
  // fSetupMemoryXfer.MinBufSize := xx;
  // fSetupMemoryXfer.MaxBufSize := yy;
  // fSetupMemoryXfer.Preferred := zz;
  fMemory.Flags := TWFF_BMP;
  // fMemory.Length := SizeOf(Mem);
  // fMemory.TheMem := @Mem;

  // fhWnd := Application.Handle;
  fShowUI := True;

  HDSMDLL := 0;
  sDefaultSource := '';
  fXfer := xfNative;
  bDataSourceManagerOpen := False;
  bDataSourceOpen := False;
  bDataSourceEnabled := False;
end;
//---------------------------------------------------------------------

destructor TTWAIN.Destroy;

begin
  if bDataSourceEnabled then
    DisableDataSource;
  if bDataSourceOpen then
    CloseDataSource;
  if bDataSourceManagerOpen then
    CloseDataSourceManager;
  fUnLoadTwain; // Loose the TWAIN_32.DLL
  if sDefaultSource <> '' then
    RestoreDefaultSourceEntry; // Write old entry back in WIN.INI
  Application.OnMessage := fOldOnMessageHandler; // Restore old OnMessage
  // handler
  inherited Destroy;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetVersionMajor: WORD;

begin
  Result := appID.Version.MajorNum;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetVersionMinor: WORD;

begin
  Result := appID.Version.MinorNum;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetVersionMajor(vmaj: WORD);

begin
  appID.Version.MajorNum := vmaj;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetVersionMinor(vmin: WORD);

begin
  appID.Version.MinorNum := vmin;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetVersionInfo(vi: string);

var
  I, L: Integer;

begin
  FillChar(appID.Version.Info, SizeOf(appID.Version.Info), #0);
  L := Length(vi);
  if L = 0 then
    Exit;
  if L > 32 then
    L := 32;
  for I := 1 to L do
    appID.Version.Info[I - 1] := vi[I];
end;
//---------------------------------------------------------------------

function TTWAIN.fGetVersionInfo: string;

var
  I: Integer;

begin
  Result := '';
  I := 0;
  if appID.Version.Info[I] <> #0 then
    repeat
      Result := Result + appID.Version.Info[I];
      Inc(I);
    until appID.Version.Info[I] = #0;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetImageType(it: TImageType);

begin
  fSetupFileXfer.Format := TWFF_BMP; // Initialize
  fMemory.Flags := TWFF_BMP; // Initialize

  case it of
    ffTIFF:
      begin
        fSetupFileXfer.Format := TWFF_TIFF;
        fMemory.Flags := TWFF_TIFF;
      end;
    ffPICT:
      begin
        fSetupFileXfer.Format := TWFF_PICT;
        fMemory.Flags := TWFF_PICT;
      end;
    ffBMP:
      begin
        fSetupFileXfer.Format := TWFF_BMP;
        fMemory.Flags := TWFF_BMP;
      end;
    ffXBM:
      begin
        fSetupFileXfer.Format := TWFF_XBM;
        fMemory.Flags := TWFF_XBM;
      end;
    ffJFIF:
      begin
        fSetupFileXfer.Format := TWFF_JFIF;
        fMemory.Flags := TWFF_JFIF;
      end;
    ffFPX:
      begin
        fSetupFileXfer.Format := TWFF_FPX;
        fMemory.Flags := TWFF_FPX;
      end;
    ffTIFFMULTI:
      begin
        fSetupFileXfer.Format := TWFF_TIFFMULTI;
        fMemory.Flags := TWFF_TIFFMULTI;
      end;
    ffPNG:
      begin
        fSetupFileXfer.Format := TWFF_PNG;
        fMemory.Flags := TWFF_PNG;
      end;
    ffSPIFF:
      begin
        fSetupFileXfer.Format := TWFF_SPIFF;
        fMemory.Flags := TWFF_SPIFF;
      end;
    ffEXIF:
      begin
        fSetupFileXfer.Format := TWFF_EXIF;
        fMemory.Flags := TWFF_EXIF;
      end;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetFilename(fn: string);

var
  L, I: Integer;

begin
  FillChar(fSetupFileXfer.FileName, SizeOf(fSetupFileXfer.Filename), #0);
  L := Length(fn);
  if L > 0 then
    for I := 1 to L do
      fSetupFileXfer.Filename[I - 1] := fn[I];
end;
//---------------------------------------------------------------------

function TTWAIN.fGetFilename: string;

var
  I: Integer;

begin
  Result := '';
  I := 0;
  if fSetupFileXfer.Filename[I] <> #0 then
    repeat
      Result := Result + fSetupFileXfer.Filename[I];
      Inc(I);
    until fSetupFileXfer.Filename[I] = #0;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetImageType: TImageType;

begin
  Result := ffUNKNOWN; // Initialize
  case fSetupFileXfer.Format of
    TWFF_TIFF: Result := ffTIFF;
    TWFF_PICT: Result := ffPICT;
    TWFF_BMP: Result := ffBMP;
    TWFF_XBM: Result := ffXBM;
    TWFF_JFIF: Result := ffJFIF;
    TWFF_FPX: Result := ffFPX;
    TWFF_TIFFMULTI: Result := ffTIFFMULTI;
    TWFF_PNG: Result := ffPNG;
    TWFF_SPIFF: Result := ffSPIFF;
    TWFF_EXIF: Result := ffEXIF;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetCursor(cr: TCursor);

begin
  Screen.Cursor := cr;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetCursor: TCursor;

begin
  Result := Screen.Cursor;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetCountry(ct: TCountryType);

begin
  case ct of
    ctDenmark: appID.Version.Country := TWCY_DENMARK;
    ctNetherlands: appID.Version.Country := TWCY_NETHERLANDS;
    ctEngland: appID.Version.Country := TWCY_BRITAIN;
    ctFinland: appID.Version.Country := TWCY_FINLAND;
    ctFrance: appID.Version.Country := TWCY_FRANCE;
    ctGermany: appID.Version.Country := TWCY_GERMANY;
    ctItaly: appID.Version.Country := TWCY_ITALY;
    ctNorWay: appID.Version.Country := TWCY_NORWAY;
    ctSpain: appID.Version.Country := TWCY_SPAIN;
    ctUSA: appID.Version.Country := TWCY_USA;
    ctRussia: appID.Version.Country := TWCY_RUSSIA;
    ctPortugal: appID.Version.Country := TWCY_PORTUGAL;
    ctSweden: appID.Version.Country := TWCY_SWEDEN;
    ctPoland: appID.Version.Country := TWCY_POLAND;
    ctGreece: appID.Version.Country := TWCY_GREECE;
    ctTurkey: appID.Version.Country := TWCY_TURKEY;
  end;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetCountry: TCountryType;

begin
  Result := ctNetherlands; // Initialize
  case appID.Version.Country of
    TWCY_NETHERLANDS: Result := ctNetherlands;
    TWCY_DENMARK: Result := ctDenmark;
    TWCY_BRITAIN: Result := ctEngland;
    TWCY_FINLAND: Result := ctFinland;
    TWCY_FRANCE: Result := ctFrance;
    TWCY_GERMANY: Result := ctGermany;
    TWCY_NORWAY: Result := ctNorway;
    TWCY_ITALY: Result := ctItaly;
    TWCY_SPAIN: Result := ctSpain;
    TWCY_USA: Result := ctUSA;
    TWCY_RUSSIA: Result := ctRussia;
    TWCY_PORTUGAL: Result := ctPortugal;
    TWCY_SWEDEN: Result := ctSweden;
    TWCY_TURKEY: Result := ctTurkey;
    TWCY_GREECE: Result := ctGreece;
    TWCY_POLAND: Result := ctPoland;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetLanguage(lg: TLanguageType);

begin
  case lg of
    lgDanish: appID.Version.Language := TWLG_DAN;
    lgDutch: appID.Version.Language := TWLG_DUT;
    lgEnglish: appID.Version.Language := TWLG_ENG;
    lgFinnish: appID.Version.Language := TWLG_FIN;
    lgFrench: appID.Version.Language := TWLG_FRN;
    lgGerman: appID.Version.Language := TWLG_GER;
    lgNorwegian: appID.Version.Language := TWLG_NOR;
    lgItalian: appID.Version.Language := TWLG_ITN;
    lgSpanish: appID.Version.Language := TWLG_SPA;
    lgAmerican: appID.Version.Language := TWLG_USA;
    lgRussian: appID.Version.Language := TWLG_RUSSIAN;
    lgPortuguese: appID.Version.Language := TWLG_POR;
    lgSwedish: appID.Version.Language := TWLG_SWE;
    lgPolish: appID.Version.Language := TWLG_POLISH;
    lgGreek: appID.Version.Language := TWLG_GREEK;
    lgTurkish: appID.Version.Language := TWLG_TURKISH;
  end;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetLanguage: TLanguageType;

begin
  Result := lgDutch; // Initialize
  case appID.Version.Language of
    TWLG_DAN: Result := lgDanish;
    TWLG_DUT: Result := lgDutch;
    TWLG_ENG: Result := lgEnglish;
    TWLG_FIN: Result := lgFinnish;
    TWLG_FRN: Result := lgFrench;
    TWLG_GER: Result := lgGerman;
    TWLG_ITN: Result := lgItalian;
    TWLG_NOR: Result := lgNorwegian;
    TWLG_SPA: Result := lgSpanish;
    TWLG_USA: Result := lgAmerican;
    TWLG_RUSSIAN: Result := lgRussian;
    TWLG_POR: Result := lgPortuguese;
    TWLG_SWE: Result := lgSwedish;
    TWLG_POLISH: Result := lgPolish;
    TWLG_GREEK: Result := lgGreek;
    TWLG_TURKISH: Result := lgTurkish;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetManufacturer(mf: string);

var
  I, L: Integer;

begin
  FillChar(appID.Manufacturer, SizeOf(appID.Manufacturer), #0);
  L := Length(mf);
  if L = 0 then
    Exit;
  if L > 32 then
    L := 32;
  for I := 1 to L do
    appID.Manufacturer[I - 1] := mf[I];
end;
//---------------------------------------------------------------------

function TTWAIN.fGetManufacturer: string;

var
  I: Integer;

begin
  Result := '';
  I := 0;
  if appID.Manufacturer[I] <> #0 then
    repeat
      Result := Result + appID.Manufacturer[I];
      Inc(I);
    until appID.Manufacturer[I] = #0;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetProductname(pn: string);

var
  I, L: Integer;

begin
  FillChar(appID.Productname, SizeOf(appID.Productname), #0);
  L := Length(pn);
  if L = 0 then
    Exit;
  if L > 32 then
    L := 32;
  for I := 1 to L do
    appID.Productname[I - 1] := pn[I];
end;
//---------------------------------------------------------------------

function TTWAIN.fGetProductName: string;

var
  I: Integer;

begin
  Result := '';
  I := 0;
  if appID.ProductName[I] <> #0 then
    repeat
      Result := Result + appID.ProductName[I];
      Inc(I);
    until appID.ProductName[I] = #0;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetProductFamily(pf: string);

var
  I, L: Integer;

begin
  FillChar(appID.ProductFamily, SizeOf(appID.ProductFamily), #0);
  L := Length(pf);
  if L = 0 then
    Exit;
  if L > 32 then
    L := 32;
  for I := 1 to L do
    appID.ProductFamily[I - 1] := pf[I];
end;
//---------------------------------------------------------------------

function TTWAIN.fGetProductFamily: string;

var
  I: Integer;

begin
  Result := '';
  I := 0;
  if appID.ProductFamily[I] <> #0 then
    repeat
      Result := Result + appID.ProductFamily[I];
      Inc(I);
    until appID.ProductFamily[I] = #0;
end;
//---------------------------------------------------------------------

procedure TTWAIN.ScanReady;

begin
  if Assigned(fScanReady) then
    fScanReady(Self);
end;
//---------------------------------------------------------------------

procedure TTWAIN.fSetDestination(dest: TTransferType);

begin
  fXfer := dest;
end;
//---------------------------------------------------------------------

function TTWAIN.fGetDestination: TTransferType;

begin
  Result := fXfer;
end;
//----------------------------------------------------------------------

function UpCaseStr(const s: string): string;

var
  I, L: Integer;

begin
  Result := s;
  L := Length(Result);
  if L > 0 then
  begin
    for I := 1 to L do
      Result[I] := UpCase(Result[I]);
  end;
  // Result := s; // Minor bug, changed 23/05/03
end;
//----------------------------------------------------------------------
// Internal routine
//----------------------------------------------------------------------

function GetWinDir: string;

var
  WD: array[0..MAX_PATH] of Char;
  L: WORD;

begin
  WD := #0;
  GetWindowsDirectory(WD, MAX_PATH);
  Result := StrPas(WD);
  L := Length(Result);
  // Remove the "\" if any
  if L > 0 then
    if Result[L] = '\' then
      Result := Copy(Result, 1, L - 1);
end;
//----------------------------------------------------------------------
// Internal routine
//----------------------------------------------------------------------

procedure FileFindSubDir(const ffsPath: string;
  var ffsBo: Boolean);

var
  sr: TSearchRec;

begin
  if FindFirst(ffsPath + '\*.*', faAnyFile, sr) = 0 then
    repeat
      if sr.Name <> '.' then
        if sr.Name <> '..' then
          if sr.Attr and faDirectory = faDirectory then
          begin
            FileFindSubDir(ffsPath + '\' + sr.name, ffsBo);
          end
          else
          begin
            if UpCaseStr(ExtractFileExt(sr.Name)) = '.DS' then
              if UpCaseStr(sr.Name) <> 'WIATWAIN.DS' then
                ffsBo := True;
          end;
    until FindNext(sr) <> 0;
  // Error if SysUtils is not added in front of FindClose!
  SysUtils.FindClose(sr);
end;
//----------------------------------------------------------------------

function TTWAIN.IsTwainDriverAvailable: Boolean;

var
  sr: TSearchRec;
  s: string;
  Bo: Boolean;

begin
  // This routine might not be failsafe!
  // Under circumstances the twain drivers found in the directory
  // %WINDOWS%\TWAIN_32\*.ds and below could be not properly installed!
  Bo := False;
  s := GetWinDir + '\TWAIN_32';
  FileFindSubDir(s, Bo);
  Result := Bo;
end;
//---------------------------------------------------------------------

procedure TTWAIN.SaveDefaultSourceEntry;

var
  WinIni: TIniFile;

begin
  if sDefaultSource <> '' then
    Exit;
  WinIni := TIniFile.Create(Ini_File_Name);
  sDefaultSource := WinIni.ReadString('TWAIN', 'DEFAULT SOURCE', '');
  WinIni.Free;
end;
//---------------------------------------------------------------------

procedure TTWAIN.RestoreDefaultSourceEntry;

var
  WinIni: TIniFile;

begin
  if sDefaultSource = '' then
    Exit; // It is not changed by this component or it is not there...
  WinIni := TIniFile.Create(Ini_File_Name);
  WinIni.WriteString('TWAIN', 'DEFAULT SOURCE', sDefaultSource);
  WinIni.Free;
  sDefaultSource := '';
end;
//---------------------------------------------------------------------

procedure TTWAIN.InitTWAIN;

begin
  appID.ID := Application.Handle;
  fHwnd := Application.Handle;
  fLoadTwain; // Load TWAIN_32.DLL
  fOldOnMessageHandler := Application.OnMessage; // Save old pointer
  Application.OnMessage := fNewOnMessageHandler; // Set to our handler
  OpenDataSourceManager; // Open DS
end;
//---------------------------------------------------------------------

function TTWAIN.fLoadTwain: Boolean;

begin
  if HDSMDLL = 0 then
  begin
    HDSMDLL := LoadLibrary(TWAIN_DLL_Name);
    DSM_Entry := GetProcAddress(HDSMDLL, DSM_Entry_Name);
    // if @DSM_Entry = nil then
    //   raise ETwainError.Create(SErrDSMEntryNotFound);
  end;

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

procedure TTWAIN.fUnloadTwain;

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

function TTWAIN.Condition2String(ConditionCode: TW_UINT16): string;

begin
  // Texts copied from PDF Documentation: Rework needed
  case ConditionCode of
    TWCC_BADCAP: Result :=
      'Capability not supported by source or operation (get,' + CrLf +
        'set) is not supported on capability, or capability had' + CrLf +
        'dependencies on other capabilities and cannot be' + CrLf +
        'operated upon at this time';
    TWCC_BADDEST: Result := 'Unknown destination in DSM_Entry.';
    TWCC_BADPROTOCOL: Result := 'Unrecognized operation triplet.';
    TWCC_BADVALUE: Result :=
      'Data parameter out of supported range.';
    TWCC_BUMMER: Result :=
      'General failure. Unload Source immediately.';
    TWCC_CAPUNSUPPORTED: Result := 'Capability not supported by ' +
      'Data Source.';
    TWCC_CAPBADOPERATION: Result := 'Operation not supported on ' +
      'capability.';
    TWCC_CAPSEQERROR: Result :=
      'Capability has dependencies on other capabilities and ' + CrLf +
        'cannot be operated upon at this time.';
    TWCC_DENIED: Result :=
      'File System operation is denied (file is protected).';
    TWCC_PAPERDOUBLEFEED,
      TWCC_PAPERJAM: Result :=
      'Transfer failed because of a feeder error';
    TWCC_FILEEXISTS: Result :=
      'Operation failed because file already exists.';
    TWCC_FILENOTFOUND: Result := 'File not found.';
    TWCC_LOWMEMORY: Result :=
      'Not enough memory to complete the operation.';
    TWCC_MAXCONNECTIONS: Result :=
      'Data Source is connected to maximum supported number of ' +
        CrLf + 'applications.';
    TWCC_NODS: Result :=
      'Data Source Manager was unable to find the specified Data ' +
        'Source.';
    TWCC_NOTEMPTY: Result :=
      'Operation failed because directory is not empty.';
    TWCC_OPERATIONERROR: Result :=
      'Data Source or Data Source Manager reported an error to the' +
        CrLf + 'user and handled the error. No application action ' +
        'required.';
    TWCC_SEQERROR: Result :=
      'Illegal operation for current Data Source Manager' + CrLf +
        'and Data Source state.';
    TWCC_SUCCESS: Result := 'Operation was succesful.';
  else
    Result := Format('Unknown condition %.04x', [ConditionCode]);
  end;
end;
///////////////////////////////////////////////////////////////////////
// RaiseLastDSMCondition (idea: like RaiseLastWin32Error)            //
// Tries to get the status from the DSM and raises an exception      //
// with it.                                                          //
///////////////////////////////////////////////////////////////////////

procedure TTWAIN.RaiseLastDataSourceManagerCondition(module: string);

var
  status: TW_STATUS;

begin
  Assert(@DSM_Entry <> nil);
  if DSM_Entry(@appId, nil, DG_CONTROL, DAT_STATUS, MSG_GET, @status) <>
    TWRC_SUCCESS then
    raise ETwainError.Create(ERR_STATUS)
  else
    raise ETwainError.CreateFmt(ERR_DSM, [module,
      Condition2String(status.ConditionCode)]);
end;
///////////////////////////////////////////////////////////////////////
// RaiseLastDSCondition                                              //
// same again, but for the actual DS                                 //
// (should be a method of DS)                                        //
///////////////////////////////////////////////////////////////////////

procedure TTWAIN.RaiseLastDataSourceCondition(module: string);

var
  status: TW_STATUS;

begin
  Assert(@DSM_Entry <> nil);
  if DSM_Entry(@appId, @dsID, DG_CONTROL, DAT_STATUS, MSG_GET, @status) <>
    TWRC_SUCCESS then
    raise ETwainError.Create(ERR_STATUS)
  else
    raise ETwainError.CreateFmt(ERR_DSM, [module,
      Condition2String(status.ConditionCode)]);
end;
///////////////////////////////////////////////////////////////////////
// TwainCheckDSM (idea: like Win32Check or GDICheck in Graphics.pas) //
///////////////////////////////////////////////////////////////////////

procedure TTWAIN.TwainCheckDataSourceManager(res: TW_UINT16;
  module: string);

begin
  if res <> TWRC_SUCCESS then
  begin
    if res = TWRC_FAILURE then
      RaiseLastDataSourceManagerCondition(module)
    else
      raise ETwainError.CreateFmt(ERR_UNKNOWN, [module, res]);
  end;
end;
///////////////////////////////////////////////////////////////////////
// TwainCheckDS                                                      //
// same again, but for the actual DS                                 //
// (should be a method of DS)                                        //
///////////////////////////////////////////////////////////////////////

procedure TTWAIN.TwainCheckDataSource(res: TW_UINT16;
  module: string);

begin
  if res <> TWRC_SUCCESS then
  begin
    if res = TWRC_FAILURE then
      RaiseLastDataSourceCondition(module)
    else
      raise ETwainError.CreateFmt(ERR_UNKNOWN, [module, res]);
  end;
end;
///////////////////////////////////////////////////////////////////////
// CallDSMEntry:                                                     //
// Short form for DSM Calls: appId is not needed as parameter        //
///////////////////////////////////////////////////////////////////////

function TTWAIN.CallDataSourceManager(pOrigin: pTW_IDENTITY;
  DG: TW_UINT32;
  DAT: TW_UINT16;
  MSG: TW_UINT16;
  pData: TW_MEMREF): TW_UINT16;

begin
  Assert(@DSM_Entry <> nil);

  Result := DSM_Entry(@appID,
    pOrigin,
    DG,
    DAT,
    MSG,
    pData);
  if (Result <> TWRC_SUCCESS) and (DAT <> DAT_EVENT) then
  begin
  end;
end;
///////////////////////////////////////////////////////////////////////
// Short form for (actual) DS Calls. appId and dsID are not needed   //
// (this should be a DS class method)                                //
///////////////////////////////////////////////////////////////////////

function TTWAIN.CallDataSource(DG: TW_UINT32;
  DAT: TW_UINT16;
  MSG: TW_UINT16;
  pData: TW_MEMREF): TW_UINT16;

begin
  Assert(@DSM_Entry <> nil);
  Result := DSM_Entry(@appID,
    @dsID,
    DG,
    DAT,
    MSG,
    pData);
end;
///////////////////////////////////////////////////////////////////////
//  A lot of the following code is a conversion from the             //
//  twain example program (and some comments are copied, too)        //
//  (The error handling is done differently)                         //
//  Most functions should be moved to a DSM or DS class              //
///////////////////////////////////////////////////////////////////////

procedure TTWAIN.OpenDataSourceManager;

begin
  if not bDataSourceManagerOpen then
  begin
    Assert(appID.ID <> 0);
    if not fLoadTwain then
      raise ETwainError.Create(ERR_TWAIN_NOT_LOADED);

    // appID.Id := fhWnd;
    // appID.Version.MajorNum := 1;
    // appID.Version.MinorNum := 0;
    // appID.Version.Language := TWLG_USA;
    // appID.Version.Country  := TWCY_USA;
    // appID.Version.Info     := 'Twain Component';
    appID.ProtocolMajor := 1; // TWON_PROTOCOLMAJOR;
    appID.ProtocolMinor := 7; // TWON_PROTOCOLMINOR;
    appID.SupportedGroups := DG_IMAGE or DG_CONTROL;
    // appID.Productname      := 'HP ScanJet 5p';
    // appId.ProductFamily    := 'ScanJet';
    // appId.Manufacturer     := 'Hewlett-Packard';

    TwainCheckDataSourceManager(CallDataSourceManager(nil,
      DG_CONTROL,
      DAT_PARENT,
      MSG_OPENDSM,
      @fhWnd),
      'OpenDataSourceManager');

    bDataSourceManagerOpen := True;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.CloseDataSourceManager;

begin
  if bDataSourceOpen then
    raise ETwainError.Create(ERR_DSM_OPEN);

  if bDataSourceManagerOpen then
  begin
    // This call performs one important function:
    // - tells the SM which application, appID.id, is requesting SM to
    //   close
    // - be sure to test return code, failure indicates SM did not
    //   close !!

    TwainCheckDataSourceManager(CallDataSourceManager(nil,
      DG_CONTROL,
      DAT_PARENT,
      MSG_CLOSEDSM,
      @fhWnd),
      'CloseDataSourceManager');

    bDataSourceManagerOpen := False;

  end;
  fUnLoadTwain; // Loose the DLL

  if sDefaultSource <> '' then
    RestoreDefaultSourceEntry;

end;
//---------------------------------------------------------------------

function TTWAIN.IsDataSourceManagerOpen: Boolean;

begin
  Result := bDataSourceManagerOpen;
end;
//---------------------------------------------------------------------

procedure TTWAIN.OpenDataSource;

begin
  Assert(bDataSourceManagerOpen, 'Data Source Manager must be open');

  if not bDataSourceOpen then
  begin
    TwainCheckDataSourceManager(CallDataSourceManager(nil,
      DG_CONTROL,
      DAT_IDENTITY,
      MSG_OPENDS,
      @dsID),
      'OpenDataSource');
    bDataSourceOpen := True;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.CloseDataSource;

begin
  Assert(bDataSourceManagerOpen, 'Data Source Manager must be open');
  if bDataSourceOpen then
  begin
    TwainCheckDataSourceManager(CallDataSourceManager(nil,
      DG_CONTROL,
      DAT_IDENTITY,
      MSG_CLOSEDS,
      @dsID),
      'CloseDataSource');
    bDataSourceOpen := False;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.EnableDataSource;

var
  twUI: TW_USERINTERFACE;

begin
  Assert(bDataSourceOpen, 'Data Source must be open');

  if not bDataSourceEnabled then
  begin
    FillChar(twUI, SizeOf(twUI), #0);

    twUI.hParent := fhWnd;
    twUI.ShowUI := fShowUI;
    twUI.ModalUI := True;

    TwainCheckDataSourceManager(CallDataSourceManager(@dsID,
      DG_CONTROL,
      DAT_USERINTERFACE,
      MSG_ENABLEDS,
      @twUI),
      'EnableDataSource');

    bDataSourceEnabled := True;
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.DisableDataSource;

var
  twUI: TW_USERINTERFACE;

begin
  Assert(bDataSourceOpen, 'Data Source must be open');

  if bDataSourceEnabled then
  begin
    twUI.hParent := fhWnd;
    twUI.ShowUI := TW_BOOL(TWON_DONTCARE8); (*!!!!*)

    TwainCheckDataSourceManager(CallDataSourceManager(@dsID,
      DG_CONTROL,
      DAT_USERINTERFACE,
      MSG_DISABLEDS,
      @twUI),
      'DisableDataSource');

    bDataSourceEnabled := False;
  end;
end;
//---------------------------------------------------------------------

function TTWAIN.IsDataSourceOpen: Boolean;

begin
  Result := bDataSourceOpen;
end;
//---------------------------------------------------------------------

function TTWAIN.IsDataSourceEnabled: Boolean;

begin
  Result := bDataSourceEnabled;
end;
//---------------------------------------------------------------------

procedure TTWAIN.SelectDataSource;

var
  NewDSIdentity: TW_IDENTITY;
  twRC: TW_UINT16;

begin
  SaveDefaultSourceEntry;
  Assert(not bDataSourceOpen, 'Data Source must be closed');

  TwainCheckDataSourceManager(CallDataSourceManager(nil,
    DG_CONTROL,
    DAT_IDENTITY,
    MSG_GETDEFAULT,
    @NewDSIdentity),
    'SelectDataSource1');

  twRC := CallDataSourceManager(nil,
    DG_CONTROL,
    DAT_IDENTITY,
    MSG_USERSELECT,
    @NewDSIdentity);

  case twRC of
    TWRC_SUCCESS: dsID := NewDSIdentity; // log in new Source
    TWRC_CANCEL: ; // keep the current Source
  else
    TwainCheckDataSourceManager(twRC, 'SelectDataSource2');
  end;
end;
(*******************************************************************
  Functions from CAPTEST.C
*******************************************************************)

procedure TTWAIN.XferMech;

var
  cap: TW_CAPABILITY;
  pVal: pTW_ONEVALUE;

begin
  fXfer := xfNative; // Override
  cap.Cap := ICAP_XFERMECH;
  cap.ConType := TWON_ONEVALUE;
  cap.hContainer := GlobalAlloc(GHND, SizeOf(TW_ONEVALUE));
  Assert(cap.hContainer <> 0);
  try
    pval := pTW_ONEVALUE(GlobalLock(cap.hContainer));
    Assert(pval <> nil);
    try
      pval.ItemType := TWTY_UINT16;
      case fXfer of
        xfMemory: pval.Item := TWSX_MEMORY;
        xfFile: pval.Item := TWSX_FILE;
        xfNative: pval.Item := TWSX_NATIVE;
      end;
    finally
      GlobalUnlock(cap.hContainer);
    end;

    TwainCheckDataSource(CallDataSource(DG_CONTROL,
      DAT_CAPABILITY,
      MSG_SET,
      @cap),
      'XferMech');

  finally
    GlobalFree(cap.hContainer);
  end;

end;
///////////////////////////////////////////////////////////////////////

function TTWAIN.ProcessSourceMessage(var Msg: TMsg): Boolean;

var
  twRC: TW_UINT16;
  event: TW_EVENT;
  pending: TW_PENDINGXFERS;

begin
  Result := False;

  if bDataSourceManagerOpen and bDataSourceOpen then
  begin
    event.pEvent := @Msg;
    event.TWMessage := 0;

    twRC := CallDataSource(DG_CONTROL,
      DAT_EVENT,
      MSG_PROCESSEVENT,
      @event);

    case event.TWMessage of
      MSG_XFERREADY:
        begin
          case fXfer of
            xfNative: fNativeXfer;
            xfMemory: fMemoryXfer;
            xfFile: fFileXfer;
          end;
          TwainCheckDataSource(CallDataSource(DG_CONTROL,
            DAT_PENDINGXFERS,
            MSG_ENDXFER,
            @pending),
            'Check for Pending Transfers');

          if pending.Count > 0 then
            TwainCheckDataSource(CallDataSource(
              DG_CONTROL,
              DAT_PENDINGXFERS,
              MSG_RESET,
              @pending),
              'Abort Pending Transfers');

          DisableDataSource;
          CloseDataSource;
          ScanReady; // Event
        end;
      MSG_CLOSEDSOK,
        MSG_CLOSEDSREQ:
        begin
          DisableDataSource;
          CloseDataSource;
          ScanReady // Event
        end;
    end;

    Result := not (twRC = TWRC_NOTDSEVENT);
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.Acquire(aBmp: TBitmap);

begin
  // fOldOnMessageHandler := Application.OnMessage; // Save old pointer
  // Application.OnMessage := fNewOnMessageHandler; // Set to our handler
  // OpenDataSourceManager;                         // Open DS
  fBitmap := aBmp;
  OpenDataSourceManager;
  OpenDataSource;
  XferMech; // Must be written for xfMemory and xfFile
  EnableDataSource;
end;
//---------------------------------------------------------------------
// Must be written!

function TTWAIN.fMemoryXfer: Boolean;

var
  twRC: TW_UINT16;

begin
  Result := False;
  twRC := CallDataSource(DG_IMAGE,
    DAT_IMAGEMEMXFER,
    MSG_GET,
    nil);
  case twRC of
    TWRC_XFERDONE: Result := True;
    TWRC_CANCEL: ;
    TWRC_FAILURE: ;
  end;
end;
//---------------------------------------------------------------------
// Must be written!

function TTWAIN.fFileXfer: Boolean;

var
  twRC: TW_UINT16;

begin
  // Not yet implemented!
  Result := False;
  twRC := CallDataSource(DG_IMAGE,
    DAT_IMAGEFILEXFER,
    MSG_GET,
    nil);
  case twRC of
    TWRC_XFERDONE: Result := True;
    TWRC_CANCEL: ;
    TWRC_FAILURE: ;
  end;
end;
//---------------------------------------------------------------------

function TTWAIN.fNativeXfer: Boolean;
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  function DibNumColors(dib: Pointer): Integer;

  var
    lpbi: PBITMAPINFOHEADER;
    lpbc: PBITMAPCOREHEADER;
    bits: Integer;

  begin
    lpbi := dib;
    lpbc := dib;

    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;

    case bits of
      1: Result := 2;
      4: Result := 16; // 4?
      8: Result := 256; // 8?
    else
      Result := 0;
    end;
  end;
  // - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
var
  twRC: TW_UINT16;
  hDIB: TW_UINT32;
  hBmp: HBITMAP;
  lpDib: ^TBITMAPINFO;
  lpBits: PChar;
  ColorTableSize: Integer;
  dc: HDC;

begin
  Result := False;

  twRC := CallDataSource(DG_IMAGE, DAT_IMAGENATIVEXFER, MSG_GET, @hDIB);

  case twRC of
    TWRC_XFERDONE:
      begin
        lpDib := GlobalLock(hDIB);
        try
          ColorTableSize := (DibNumColors(lpDib) *
            SizeOf(RGBQUAD));

          lpBits := PChar(lpDib);
          Inc(lpBits, lpDib.bmiHeader.biSize);
          Inc(lpBits, ColorTableSize);

          dc := GetDC(0);
          try
            hBMP := CreateDIBitmap(dc, lpdib.bmiHeader,
              CBM_INIT, lpBits, lpDib^, DIB_RGB_COLORS);

            fBitmap.Handle := hBMP;

            Result := True;
          finally
            ReleaseDC(0, dc);
          end;
        finally
          GlobalUnlock(hDIB);
          GlobalFree(hDIB);
        end;
      end;
    TWRC_CANCEL: ;
    TWRC_FAILURE: RaiseLastDataSourceManagerCondition('Native Transfer');
  end;
end;
//---------------------------------------------------------------------

procedure TTWAIN.fNewOnMessageHandler(var Msg: TMsg;
  var Handled: Boolean);

begin
  Handled := ProcessSourceMessage(Msg);
  if Assigned(fOldOnMessageHandler) then
    fOldOnMessageHandler(Msg, Handled)
end;
//---------------------------------------------------------------------

procedure Register;

begin
  RegisterComponents('Samples', [TTWAIN]);
end;
//---------------------------------------------------------------------
end.
//---------------------------------------------------------------------


Component Download: mhtwain.zip

Nincsenek megjegyzések:

Megjegyzés küldése