Как работать со сканером?

Code:

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

//                                                                    //

//               Delphi Scanner Support Framework                     //

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

//                                                                    //

//         Modified and rewritten as a Delphi component by:           //

//                                                                    //

//                           M. de Haan                               //

//                                                                    //

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

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;