Scanner - componente para capturar imagem do scanner

Top Previous Next

// componente para capturar imagem do scanner

////////////////////////////////////////////////////////////////////////

// //

// Delphi Scanner Support Framework //

// //

////////////////////////////////////////////////////////////////////////

// //

// 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;

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

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;

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

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;

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

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;

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

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;

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

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;

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

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;

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

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;

///////////////////////////////////////////////////////////////////////

// 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;

///////////////////////////////////////////////////////////////////////

// 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;

///////////////////////////////////////////////////////////////////////

// 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;

///////////////////////////////////////////////////////////////////////

// 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;

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

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;

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

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;

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

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;

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

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;

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

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;

(*******************************************************************

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;

///////////////////////////////////////////////////////////////////////

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;

Result := not (twRC = TWRC_NOTDSEVENT);

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;

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

// 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;

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

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;

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

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;

TWRC_CANCEL : ;

TWRC_FAILURE : RaiseLastDataSourceManagerCondition('Native Transfer');

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.

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