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.
//---------------------------------------------------------------------
|
Sign Up
