Scanner - componente para capturar imagem do scanner

Top  Previous  Next

// componente para capturar imagem do scanner

 

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

//                                                                    // 

//               Delphi Scanner Support Framework                     // 

//                                                                    // 

//               Copyright (C) 1999 by Uli Tessel                     // 

//                                                                    // 

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

//                                                                    // 

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

//                                                                    // 

//                           M. de Haan                               // 

//                                                                    // 

//                           June 2002                                // 

//                                                                    // 

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

 

 

Unit 

   TWAIN; 

 

Interface 

 

Uses 

   SysUtils,   // Exceptions 

   Forms,      // TMessageEvent 

   Windows,    // HMODULE 

   Graphics,   // TBitmap 

   IniFiles,   // Inifile 

   Controls,   // TCursor 

   Classes;    // Class 

 

Const 

   // Messages 

   MSG_GET           = $0001// Get one or more values 

   MSG_GETCURRENT    = $0002// Get current value 

   MSG_GETDEFAULT    = $0003// Get default (e.g. power up) value 

   MSG_GETFIRST      = $0004// Get first of a series of items, 

                              // e.g. Data Sources 

   MSG_GETNEXT       = $0005// Iterate through a series of items 

   MSG_SET           = $0006// Set one or more values 

   MSG_RESET         = $0007// Set current value to default value 

   MSG_QUERYSUPPORT  = $0008// Get supported operations on the 

                              // capacities 

 

   // Messages used with DAT_NULL 

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

   MSG_XFERREADY     = $0101// The data source has data ready 

   MSG_CLOSEDSREQ    = $0102// Request for the application to close 

                              // the Data Source 

   MSG_CLOSEDSOK     = $0103// Tell the application to save the 

                              // state 

   MSG_DEVICEEVENT   = $0104// Some event has taken place 

 

   // Messages used with a pointer to a DAT_STATUS structure 

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

   MSG_CHECKSTATUS   = $0201// Get status information 

 

   // Messages used with a pointer to DAT_PARENT data 

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

   MSG_OPENDSM       = $0301// Open the Data Source Manager 

   MSG_CLOSEDSM      = $0302// Close the Data Source Manager 

 

   // Messages used with a pointer to a DAT_IDENTITY structure 

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

   MSG_OPENDS        = $0401// Open a Data Source 

   MSG_CLOSEDS       = $0402// Close a Data Source 

   MSG_USERSELECT    = $0403// Put up a dialog of all Data Sources 

                              // The user can select a Data Source 

 

   // Messages used with a pointer to a DAT_USERINTERFACE structure 

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

   MSG_DISABLEDS     = $0501;  // Disable data transfer in the Data 

                               // Source 

   MSG_ENABLEDS      = $0502;  // Enable data transfer in the Data 

                               // Source 

   MSG_ENABLEDSUIONLY = $0503// Enable for saving Data Source state 

                               // only 

 

   // Messages used with a pointer to a DAT_EVENT structure 

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

   MSG_PROCESSEVENT  = $0601

 

   // Messages used with a pointer to a DAT_PENDINGXFERS structure 

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

   MSG_ENDXFER       = $0701

   MSG_STOPFEEDER    = $0702

 

   // Messages used with a pointer to a DAT_FILESYSTEM structure 

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

   MSG_CHANGEDIRECTORY           = $0801

   MSG_CREATEDIRECTORY           = $0802

   MSG_DELETE                    = $0803

   MSG_FORMATMEDIA               = $0804

   MSG_GETCLOSE                  = $0805

   MSG_GETFIRSTFILE              = $0806

   MSG_GETINFO                   = $0807

   MSG_GETNEXTFILE               = $0808

   MSG_RENAME                    = $0809

   MSG_COPY                      = $080A

   MSG_AUTOMATICCAPTUREDIRECTORY = $080B

 

   // Messages used with a pointer to a DAT_PASSTHRU structure 

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

   MSG_PASSTHRU      = $0901

 

Const 

   DG_CONTROL        = $0001// data pertaining to control 

   DG_IMAGE          = $0002// data pertaining to raster images 

 

Const 

   // Data Argument Types for the DG_CONTROL Data Group. 

   DAT_CAPABILITY    = $0001// TW_CAPABILITY 

   DAT_EVENT         = $0002// TW_EVENT 

   DAT_IDENTITY      = $0003// TW_IDENTITY 

   DAT_PARENT        = $0004// TW_HANDLE, 

                              // application win handle in Windows 

   DAT_PENDINGXFERS  = $0005// TW_PENDINGXFERS 

   DAT_SETUPMEMXFER  = $0006// TW_SETUPMEMXFER 

   DAT_SETUPFILEXFER = $0007// TW_SETUPFILEXFER 

   DAT_STATUS        = $0008// TW_STATUS 

   DAT_USERINTERFACE = $0009// TW_USERINTERFACE 

   DAT_XFERGROUP     = $000A// TW_UINT32 

   DAT_IMAGEMEMXFER  = $0103// TW_IMAGEMEMXFER 

   DAT_IMAGENATIVEXFER = $0104// TW_UINT32, loword is hDIB, PICHandle 

   DAT_IMAGEFILEXFER = $0105// Null data 

 

Const 

   // Condition Codes: Application gets these by doing DG_CONTROL 

   // DAT_STATUS MSG_GET. 

   TWCC_CUSTOMBASE   = $8000

   TWCC_SUCCESS      = 00// It worked! 

   TWCC_BUMMER       = 01// Failure due to unknown causes 

   TWCC_LOWMEMORY    = 02// Not enough memory to perform operation 

   TWCC_NODS         = 03// No Data Source 

   TWCC_MAXCONNECTIONS = 04// Data Source is connected to maximum 

                             // number of possible applications 

   TWCC_OPERATIONERROR    = 05// Data Source or Data Source Manager 

                                // reported error, application 

                                // shouldn't report an error 

   TWCC_BADCAP       = 06// Unknown capability 

   TWCC_BADPROTOCOL  = 09// Unrecognized MSG DG DAT combination 

   TWCC_BADVALUE     = 10// Data parameter out of range 

   TWCC_SEQERROR     = 11// DG DAT MSG out of expected sequence 

   TWCC_BADDEST      = 12// Unknown destination Application / 

                           // Source in DSM_Entry 

   TWCC_CAPUNSUPPORTED = 13// Capability not supported by source 

   TWCC_CAPBADOPERATION = 14// Operation not supported by 

                                // capability 

   TWCC_CAPSEQERROR  = 15// Capability has dependancy on other 

                           // capability 

   TWCC_DENIED       = 16// File System operation is denied 

                           // (file is protected) 

   TWCC_FILEEXISTS   = 17// Operation failed because file 

                           // already exists 

   TWCC_FILENOTFOUND = 18// File not found 

   TWCC_NOTEMPTY     = 19// Operation failed because directory 

                           // is not empty 

   TWCC_PAPERJAM     = 20// The feeder is jammed 

   TWCC_PAPERDOUBLEFEED = 21// The feeder detected multiple pages 

   TWCC_FILEWRITEERROR = 22// Error writing the file (meant for 

                             // things like disk full conditions) 

   TWCC_CHECKDEVICEONLINE = 23// The device went offline prior to or 

                                // during this operation 

 

Const 

   // Flags used in TW_MEMORY structure 

   TWMF_APPOWNS      = $01

   TWMF_DSMOWNS      = $02

   TWMF_DSOWNS       = $04

   TWMF_POINTER      = $08

   TWMF_HANDLE       = $10

 

Const 

   // Flags for country, which seems to be equal to their telephone 

   // number 

   TWCY_AFGHANISTAN    = 1001

   TWCY_ALGERIA        = 0213

   TWCY_AMERICANSAMOA  = 0684

   TWCY_ANDORRA        = 0033

   TWCY_ANGOLA         = 1002

   TWCY_ANGUILLA       = 8090

   TWCY_ANTIGUA        = 8091

   TWCY_ARGENTINA      = 0054

   TWCY_ARUBA          = 0297

   TWCY_ASCENSIONI     = 0247

   TWCY_AUSTRALIA      = 0061

   TWCY_AUSTRIA        = 0043

   TWCY_BAHAMAS        = 8092

   TWCY_BAHRAIN        = 0973

   TWCY_BANGLADESH     = 0880

   TWCY_BARBADOS       = 8093

   TWCY_BELGIUM        = 0032

   TWCY_BELIZE         = 0501

   TWCY_BENIN          = 0229

   TWCY_BERMUDA        = 8094

   TWCY_BHUTAN         = 1003

   TWCY_BOLIVIA        = 0591

   TWCY_BOTSWANA       = 0267

   TWCY_BRITAIN        = 0006

   TWCY_BRITVIRGINIS   = 8095

   TWCY_BRAZIL         = 0055

   TWCY_BRUNEI         = 0673

   TWCY_BULGARIA       = 0359

   TWCY_BURKINAFASO    = 1004

   TWCY_BURMA          = 1005

   TWCY_BURUNDI        = 1006

   TWCY_CAMAROON       = 0237

   TWCY_CANADA         = 0002

   TWCY_CAPEVERDEIS    = 0238

   TWCY_CAYMANIS       = 8096

   TWCY_CENTRALAFREP   = 1007

   TWCY_CHAD           = 1008

   TWCY_CHILE          = 0056

   TWCY_CHINA          = 0086

   TWCY_CHRISTMASIS    = 1009

   TWCY_COCOSIS        = 1009

   TWCY_COLOMBIA       = 0057

   TWCY_COMOROS        = 1010

   TWCY_CONGO          = 1011

   TWCY_COOKIS         = 1012

   TWCY_COSTARICA      = 0506

   TWCY_CUBA           = 0005

   TWCY_CYPRUS         = 0357

   TWCY_CZECHOSLOVAKIA = 0042

   TWCY_DENMARK        = 0045

   TWCY_DJIBOUTI       = 1013

   TWCY_DOMINICA       = 8097

   TWCY_DOMINCANREP    = 8098

   TWCY_EASTERIS       = 1014

   TWCY_ECUADOR        = 0593

   TWCY_EGYPT          = 0020

   TWCY_ELSALVADOR     = 0503

   TWCY_EQGUINEA       = 1015

   TWCY_ETHIOPIA       = 0251

   TWCY_FALKLANDIS     = 1016

   TWCY_FAEROEIS       = 0298

   TWCY_FIJIISLANDS    = 0679

   TWCY_FINLAND        = 0358

   TWCY_FRANCE         = 0033

   TWCY_FRANTILLES     = 0596

   TWCY_FRGUIANA       = 0594

   TWCY_FRPOLYNEISA    = 0689

   TWCY_FUTANAIS       = 1043

   TWCY_GABON          = 0241

   TWCY_GAMBIA         = 0220

   TWCY_GERMANY        = 0049

   TWCY_GHANA          = 0233

   TWCY_GIBRALTER      = 0350

   TWCY_GREECE         = 0030

   TWCY_GREENLAND      = 0299

   TWCY_GRENADA        = 8099

   TWCY_GRENEDINES     = 8015

   TWCY_GUADELOUPE     = 0590

   TWCY_GUAM           = 0671

   TWCY_GUANTANAMOBAY  = 5399

   TWCY_GUATEMALA      = 0502

   TWCY_GUINEA         = 0224

   TWCY_GUINEABISSAU   = 1017

   TWCY_GUYANA         = 0592

   TWCY_HAITI          = 0509

   TWCY_HONDURAS       = 0504

   TWCY_HONGKONG       = 0852

   TWCY_HUNGARY        = 0036

   TWCY_ICELAND        = 0354

   TWCY_INDIA          = 0091

   TWCY_INDONESIA      = 0062

   TWCY_IRAN           = 0098

   TWCY_IRAQ           = 0964

   TWCY_IRELAND        = 0353

   TWCY_ISRAEL         = 0972

   TWCY_ITALY          = 0039

   TWCY_IVORYCOAST     = 0225

   TWCY_JAMAICA        = 8010

   TWCY_JAPAN          = 0081

   TWCY_JORDAN         = 0962

   TWCY_KENYA          = 0254

   TWCY_KIRIBATI       = 1018

   TWCY_KOREA          = 0082

   TWCY_KUWAIT         = 0965

   TWCY_LAOS           = 1019

   TWCY_LEBANON        = 1020

   TWCY_LIBERIA        = 0231

   TWCY_LIBYA          = 0218

   TWCY_LIECHTENSTEIN  = 0041

   TWCY_LUXENBOURG     = 0352

   TWCY_MACAO          = 0853

   TWCY_MADAGASCAR     = 1021

   TWCY_MALAWI         = 0265

   TWCY_MALAYSIA       = 0060

   TWCY_MALDIVES       = 0960

   TWCY_MALI           = 1022

   TWCY_MALTA          = 0356

   TWCY_MARSHALLIS     = 0692

   TWCY_MAURITANIA     = 1023

   TWCY_MAURITIUS      = 0230

   TWCY_MEXICO         = 0003

   TWCY_MICRONESIA     = 0691

   TWCY_MIQUELON       = 0508

   TWCY_MONACO         = 0033

   TWCY_MONGOLIA       = 1024

   TWCY_MONTSERRAT     = 8011

   TWCY_MOROCCO        = 0212

   TWCY_MOZAMBIQUE     = 1025

   TWCY_NAMIBIA        = 0264

   TWCY_NAURU          = 1026

   TWCY_NEPAL          = 0977

   TWCY_NETHERLANDS    = 0031

   TWCY_NETHANTILLES   = 0599

   TWCY_NEVIS          = 8012

   TWCY_NEWCALEDONIA   = 0687

   TWCY_NEWZEALAND     = 0064

   TWCY_NICARAGUA      = 0505

   TWCY_NIGER          = 0227

   TWCY_NIGERIA        = 0234

   TWCY_NIUE           = 1027

   TWCY_NORFOLKI       = 1028

   TWCY_NORWAY         = 0047

   TWCY_OMAN           = 0968

   TWCY_PAKISTAN       = 0092

   TWCY_PALAU          = 1029

   TWCY_PANAMA         = 0507

   TWCY_PARAGUAY       = 0595

   TWCY_PERU           = 0051

   TWCY_PHILLIPPINES   = 0063

   TWCY_PITCAIRNIS     = 1030

   TWCY_PNEWGUINEA     = 0675

   TWCY_POLAND         = 0048

   TWCY_PORTUGAL       = 0351

   TWCY_QATAR          = 0974

   TWCY_REUNIONI       = 1031

   TWCY_ROMANIA        = 0040

   TWCY_RWANDA         = 0250

   TWCY_SAIPAN         = 0670

   TWCY_SANMARINO      = 0039

   TWCY_SAOTOME        = 1033

   TWCY_SAUDIARABIA    = 0966

   TWCY_SENEGAL        = 0221

   TWCY_SEYCHELLESIS   = 1034

   TWCY_SIERRALEONE    = 1035

   TWCY_SINGAPORE      = 0065

   TWCY_SOLOMONIS      = 1036

   TWCY_SOMALI         = 1037

   TWCY_SOUTHAFRICA    = 0027

   TWCY_SPAIN          = 0034

   TWCY_SRILANKA       = 0094

   TWCY_STHELENA       = 1032

   TWCY_STKITTS        = 8013

   TWCY_STLUCIA        = 8014

   TWCY_STPIERRE       = 0508

   TWCY_STVINCENT      = 8015

   TWCY_SUDAN          = 1038

   TWCY_SURINAME       = 0597

   TWCY_SWAZILAND      = 0268

   TWCY_SWEDEN         = 0046

   TWCY_SWITZERLAND    = 0041

   TWCY_SYRIA          = 1039

   TWCY_TAIWAN         = 0886

   TWCY_TANZANIA       = 0255

   TWCY_THAILAND       = 0066

   TWCY_TOBAGO         = 8016

   TWCY_TOGO           = 0228

   TWCY_TONGAIS        = 0676

   TWCY_TRINIDAD       = 8016

   TWCY_TUNISIA        = 0216

   TWCY_TURKEY         = 0090

   TWCY_TURKSCAICOS    = 8017

   TWCY_TUVALU         = 1040

   TWCY_UGANDA         = 0256

   TWCY_USSR           = 0007

   TWCY_UAEMIRATES     = 0971

   TWCY_UNITEDKINGDOM  = 0044

   TWCY_USA            = 0001

   TWCY_URUGUAY        = 0598

   TWCY_VANUATU        = 1041

   TWCY_VATICANCITY    = 0039

   TWCY_VENEZUELA      = 0058

   TWCY_WAKE           = 1042

   TWCY_WALLISIS       = 1043

   TWCY_WESTERNSAHARA  = 1044

   TWCY_WESTERNSAMOA   = 1045

   TWCY_YEMEN          = 1046

   TWCY_YUGOSLAVIA     = 0038

   TWCY_ZAIRE          = 0243

   TWCY_ZAMBIA         = 0260

   TWCY_ZIMBABWE       = 0263

   TWCY_ALBANIA        = 0355

   TWCY_ARMENIA        = 0374

   TWCY_AZERBAIJAN     = 0994

   TWCY_BELARUS        = 0375

   TWCY_BOSNIAHERZGO   = 0387

   TWCY_CAMBODIA       = 0855

   TWCY_CROATIA        = 0385

   TWCY_CZECHREPUBLIC  = 0420

   TWCY_DIEGOGARCIA    = 0246

   TWCY_ERITREA        = 0291

   TWCY_ESTONIA        = 0372

   TWCY_GEORGIA        = 0995

   TWCY_LATVIA         = 0371

   TWCY_LESOTHO        = 0266

   TWCY_LITHUANIA      = 0370

   TWCY_MACEDONIA      = 0389

   TWCY_MAYOTTEIS      = 0269

   TWCY_MOLDOVA        = 0373

   TWCY_MYANMAR        = 0095

   TWCY_NORTHKOREA     = 0850

   TWCY_PUERTORICO     = 0787

   TWCY_RUSSIA         = 0007

   TWCY_SERBIA         = 0381

   TWCY_SLOVAKIA       = 0421

   TWCY_SLOVENIA       = 0386

   TWCY_SOUTHKOREA     = 0082

   TWCY_UKRAINE        = 0380

   TWCY_USVIRGINIS     = 0340

   TWCY_VIETNAM        = 0084

 

Const 

   // Flags for languages 

   TWLG_DAN                  = 000// Danish 

   TWLG_DUT                  = 001// Dutch 

   TWLG_ENG                  = 002// English 

   TWLG_FCF                  = 003// French Canadian 

   TWLG_FIN                  = 004// Finnish 

   TWLG_FRN                  = 005// French 

   TWLG_GER                  = 006// German 

   TWLG_ICE                  = 007// Icelandic 

   TWLG_ITN                  = 008// Italian 

   TWLG_NOR                  = 009// Norwegian 

   TWLG_POR                  = 010// Portuguese 

   TWLG_SPA                  = 011// Spannish 

   TWLG_SWE                  = 012// Swedish 

   TWLG_USA                  = 013

   TWLG_AFRIKAANS            = 014

   TWLG_ALBANIA              = 015

   TWLG_ARABIC               = 016

   TWLG_ARABIC_ALGERIA       = 017

   TWLG_ARABIC_BAHRAIN       = 018

   TWLG_ARABIC_EGYPT         = 019

   TWLG_ARABIC_IRAQ          = 020

   TWLG_ARABIC_JORDAN        = 021

   TWLG_ARABIC_KUWAIT        = 022

   TWLG_ARABIC_LEBANON       = 023

   TWLG_ARABIC_LIBYA         = 024

   TWLG_ARABIC_MOROCCO       = 025

   TWLG_ARABIC_OMAN          = 026

   TWLG_ARABIC_QATAR         = 027

   TWLG_ARABIC_SAUDIARABIA   = 028

   TWLG_ARABIC_SYRIA         = 029

   TWLG_ARABIC_TUNISIA       = 030

   TWLG_ARABIC_UAE           = 031// United Arabic Emirates 

   TWLG_ARABIC_YEMEN         = 032

   TWLG_BASQUE               = 033

   TWLG_BYELORUSSIAN         = 034

   TWLG_BULGARIAN            = 035

   TWLG_CATALAN              = 036

   TWLG_CHINESE              = 037

   TWLG_CHINESE_HONGKONG     = 038

   TWLG_CHINESE_PRC          = 039// People's Republic of China 

   TWLG_CHINESE_SINGAPORE    = 040

   TWLG_CHINESE_SIMPLIFIED   = 041

   TWLG_CHINESE_TAIWAN       = 042

   TWLG_CHINESE_TRADITIONAL  = 043

   TWLG_CROATIA              = 044

   TWLG_CZECH                = 045

   TWLG_DANISH               = TWLG_DAN; 

   TWLG_DUTCH                = TWLG_DUT; 

   TWLG_DUTCH_BELGIAN        = 046

   TWLG_ENGLISH              = TWLG_ENG; 

   TWLG_ENGLISH_AUSTRALIAN   = 047

   TWLG_ENGLISH_CANADIAN     = 048

   TWLG_ENGLISH_IRELAND      = 049

   TWLG_ENGLISH_NEWZEALAND   = 050

   TWLG_ENGLISH_SOUTHAFRICA  = 051

   TWLG_ENGLISH_UK           = 052

   TWLG_ENGLISH_USA          = TWLG_USA; 

   TWLG_ESTONIAN             = 053

   TWLG_FAEROESE             = 054

   TWLG_FARSI                = 055

   TWLG_FINNISH              = TWLG_FIN; 

   TWLG_FRENCH               = TWLG_FRN; 

   TWLG_FRENCH_BELGIAN       = 056

   TWLG_FRENCH_CANADIAN      = TWLG_FCF; 

   TWLG_FRENCH_LUXEMBOURG    = 057

   TWLG_FRENCH_SWISS         = 058

   TWLG_GERMAN               = TWLG_GER; 

   TWLG_GERMAN_AUSTRIAN      = 059

   TWLG_GERMAN_LUXEMBOURG    = 060

   TWLG_GERMAN_LIECHTENSTEIN = 061

   TWLG_GERMAN_SWISS         = 062

   TWLG_GREEK                = 063

   TWLG_HEBREW               = 064

   TWLG_HUNGARIAN            = 065

   TWLG_ICELANDIC            = TWLG_ICE; 

   TWLG_INDONESIAN           = 066

   TWLG_ITALIAN              = TWLG_ITN; 

   TWLG_ITALIAN_SWISS        = 067

   TWLG_JAPANESE             = 068

   TWLG_KOREAN               = 069

   TWLG_KOREAN_JOHAB         = 070

   TWLG_LATVIAN              = 071

   TWLG_LITHUANIAN           = 072

   TWLG_NORWEGIAN            = TWLG_NOR; 

   TWLG_NORWEGIAN_BOKMAL     = 073

   TWLG_NORWEGIAN_NYNORSK    = 074

   TWLG_POLISH               = 075

   TWLG_PORTUGUESE           = TWLG_POR; 

   TWLG_PORTUGUESE_BRAZIL    = 076

   TWLG_ROMANIAN             = 077

   TWLG_RUSSIAN              = 078

   TWLG_SERBIAN_LATIN        = 079

   TWLG_SLOVAK               = 080

   TWLG_SLOVENIAN            = 081

   TWLG_SPANISH              = TWLG_SPA; 

   TWLG_SPANISH_MEXICAN      = 082

   TWLG_SPANISH_MODERN       = 083

   TWLG_SWEDISH              = TWLG_SWE; 

   TWLG_THAI                 = 084

   TWLG_TURKISH              = 085

   TWLG_UKRANIAN             = 086

   TWLG_ASSAMESE             = 087

   TWLG_BENGALI              = 088

   TWLG_BIHARI               = 089

   TWLG_BODO                 = 090

   TWLG_DOGRI                = 091

   TWLG_GUJARATI             = 092

   TWLG_HARYANVI             = 093

   TWLG_HINDI                = 094

   TWLG_KANNADA              = 095

   TWLG_KASHMIRI             = 096

   TWLG_MALAYALAM            = 097

   TWLG_MARATHI              = 098

   TWLG_MARWARI              = 099

   TWLG_MEGHALAYAN           = 100

   TWLG_MIZO                 = 101

   TWLG_NAGA                 = 102

   TWLG_ORISSI               = 103

   TWLG_PUNJABI              = 104

   TWLG_PUSHTU               = 105

   TWLG_SERBIAN_CYRILLIC     = 106

   TWLG_SIKKIMI              = 107

   TWLG_SWEDISH_FINLAND      = 108

   TWLG_TAMIL                = 109

   TWLG_TELUGU               = 110

   TWLG_TRIPURI              = 111

   TWLG_URDU                 = 112

   TWLG_VIETNAMESE           = 113

 

Const 

   TWRC_SUCCESS           = 0

   TWRC_FAILURE           = 1// Application may get TW_STATUS for 

                               // info on failure 

   TWRC_CHECKSTATUS       = 2// tried hard to get the status 

   TWRC_CANCEL            = 3

   TWRC_DSEVENT           = 4

   TWRC_NOTDSEVENT        = 5

   TWRC_XFERDONE          = 6

   TWRC_ENDOFLIST         = 7// After MSG_GETNEXT if nothing left 

   TWRC_INFONOTSUPPORTED  = 8

   TWRC_DATANOTAVAILABLE  = 9

 

Const 

   TWON_ONEVALUE     = $05// indicates TW_ONEVALUE container 

   TWON_DONTCARE8    = $FF

 

Const 

   ICAP_XFERMECH     = $0103

 

Const 

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

 

Const 

   // ICAP_XFERMECH values (SX_ means Setup XFer) 

   TWSX_NATIVE       = 0

   TWSX_FILE         = 1

   TWSX_MEMORY       = 2

   TWSX_FILE2        = 3

 

Type 

   TW_UINT16   = WORD;         // unsigned short TW_UINT16 

   pTW_UINT16  = ^TW_UINT16; 

   TTWUInt16   = TW_UINT16; 

   PTWUInt16   = pTW_UINT16; 

 

Type 

   TW_BOOL     = WORDBOOL;     // unsigned short TW_BOOL 

   pTW_BOOL    = ^TW_BOOL; 

   TTWBool     = TW_BOOL; 

   PTWBool     = pTW_BOOL; 

 

Type 

   TW_STR32    = Array[0..33of Char;   // char TW_STR32[34] 

   pTW_STR32   = ^TW_STR32; 

   TTWStr32    = TW_STR32; 

   PTWStr32    = pTW_STR32; 

 

Type 

   TW_STR255   = Array[0..255of Char;  // char TW_STR255[256] 

   pTW_STR255  = ^TW_STR255; 

   TTWStr255   = TW_STR255; 

   PTWStr255   = pTW_STR255; 

 

Type 

   TW_INT16    = SmallInt;    // short TW_INT16 

   pTW_INT16   = ^TW_INT16; 

   TTWInt16    = TW_INT16; 

   PTWInt16    = pTW_INT16; 

 

Type 

   TW_UINT32   = ULONG;       // unsigned long TW_UINT32 

   pTW_UINT32  = ^TW_UINT32; 

   TTWUInt32   = TW_UINT32; 

   PTWUInt32   = pTW_UINT32; 

 

Type 

   TW_HANDLE   = THandle; 

   TTWHandle   = TW_HANDLE; 

   TW_MEMREF   = Pointer; 

   TTWMemRef   = TW_MEMREF; 

 

Type 

   // DAT_PENDINGXFERS. Used with MSG_ENDXFER to indicate additional 

   // data 

   TW_PENDINGXFERS = Packed record 

      Count    : TW_UINT16; 

      Case Boolean of 

         False : (EOJ      : TW_UINT32); 

         True  : (Reserved : TW_UINT32); 

      End

   pTW_PENDINGXFERS = ^TW_PENDINGXFERS; 

   TTWPendingXFERS  = TW_PENDINGXFERS; 

   PTWPendingXFERS  = pTW_PENDINGXFERS; 

 

Type 

   // DAT_EVENT. For passing events down from the application to the DS 

   TW_EVENT = Packed record 

      pEvent    : TW_MEMREF; // Windows pMSG or Mac pEvent. 

      TWMessage : TW_UINT16; // TW msg from data source, e.g. 

                             // MSG_XFERREADY 

      End

   pTW_EVENT   = ^TW_EVENT; 

   TTWEvent    = TW_EVENT; 

   PTWEvent    = pTW_EVENT; 

 

Type 

   // TWON_ONEVALUE. Container for one value 

   TW_ONEVALUE = Packed record 

      ItemType : TW_UINT16; 

      Item     : TW_UINT32; 

      End

   pTW_ONEVALUE = ^TW_ONEVALUE; 

   TTWOneValue  = TW_ONEVALUE; 

   PTWOneValue  = pTW_ONEVALUE; 

 

Type 

   // DAT_CAPABILITY. Used by application to get/set capability from/in 

   // a data source. 

   TW_CAPABILITY = Packed record 

      Cap        : TW_UINT16; // id of capability to set or get, e.g. 

                              // CAP_BRIGHTNESS 

      ConType    : TW_UINT16; // TWON_ONEVALUE, _RANGE, _ENUMERATION or 

                              // _ARRAY 

      hContainer : TW_HANDLE; // Handle to container of type Dat 

      End

   pTW_CAPABILITY = ^TW_CAPABILITY; 

   TTWCapability  = TW_CAPABILITY; 

   PTWCapability  = pTW_CAPABILITY; 

 

Type 

   // DAT_STATUS. Application gets detailed status info from a data 

   // source with this 

   TW_STATUS = Packed record 

      ConditionCode : TW_UINT16; // Any TWCC_xxx constant 

      Reserved      : TW_UINT16; // Future expansion space 

      End

   pTW_STATUS = ^TW_STATUS; 

   TTWStatus  = TW_STATUS; 

   PTWStatus  = pTW_STATUS; 

 

Type 

   // No DAT needed. Used to manage memory buffers 

   TW_MEMORY = Packed record 

      Flags  : TW_UINT32; // Any combination of the TWMF_ constants 

      Length : TW_UINT32; // Number of bytes stored in buffer TheMem 

      TheMem : TW_MEMREF; // Pointer or handle to the allocated memory 

                          // buffer 

   End

   pTW_MEMORY = ^TW_MEMORY; 

   TTWMemory  = TW_MEMORY; 

   PTWMemory  = pTW_MEMORY; 

 

Const 

   // ICAP_IMAGEFILEFORMAT values (FF_means File Format 

   TWFF_TIFF      = 0// Tagged Image File Format 

   TWFF_PICT      = 1// Macintosh PICT 

   TWFF_BMP       = 2// Windows Bitmap 

   TWFF_XBM       = 3// X-Windows Bitmap 

   TWFF_JFIF      = 4// JPEG File Interchange Format 

   TWFF_FPX       = 5// Flash Pix 

   TWFF_TIFFMULTI = 6// Multi-page tiff file 

   TWFF_PNG       = 7// Portable Network Graphic 

   TWFF_SPIFF     = 8

   TWFF_EXIF      = 9

 

Type 

   // DAT_SETUPFILEXFER. Sets up DS to application data transfer via a 

   // file 

   TW_SETUPFILEXFER = Packed record 

      FileName : TW_STR255; 

      Format   : TW_UINT16; // Any TWFF_xxx constant 

      VRefNum  : TW_INT16;  // Used for Mac only 

      End

   pTW_SETUPFILEXFER = ^TW_SETUPFILEXFER; 

   TTWSetupFileXFER  = TW_SETUPFILEXFER; 

   PTWSetupFileXFER  = pTW_SETUPFILEXFER; 

 

Type 

   // DAT_SETUPFILEXFER2. Sets up DS to application data transfer via a 

   // file. } 

   TW_SETUPFILEXFER2 = Packed record 

      FileName     : TW_MEMREF; // Pointer to file name text 

      FileNameType : TW_UINT16; // TWTY_STR1024 or TWTY_UNI512 

      Format       : TW_UINT16; // Any TWFF_xxx constant 

      VRefNum      : TW_INT16;  // Used for Mac only 

      parID        : TW_UINT32; // Used for Mac only 

      End

   pTW_SETUPFILEXFER2 = ^TW_SETUPFILEXFER2; 

   TTWSetupFileXFER2  = TW_SETUPFILEXFER2; 

   PTWSetupFileXFER2  = pTW_SETUPFILEXFER2; 

 

Type 

   // DAT_SETUPMEMXFER. Sets up Data Source to application data 

   // transfer via a memory buffer 

   TW_SETUPMEMXFER = Packed record 

      MinBufSize : TW_UINT32; 

      MaxBufSize : TW_UINT32; 

      Preferred  : TW_UINT32; 

      End

   pTW_SETUPMEMXFER = ^TW_SETUPMEMXFER; 

   TTWSetupMemXFER  = TW_SETUPMEMXFER; 

   PTWSetupMemXFER  = pTW_SETUPMEMXFER; 

 

Type 

   TW_VERSION = Packed record 

      MajorNum : TW_UINT16;  // Major revision number of the software. 

      MinorNum : TW_UINT16;  // Incremental revision number of the 

                             // software 

      Language : TW_UINT16;  // e.g. TWLG_SWISSFRENCH 

      Country  : TW_UINT16;  // e.g. TWCY_SWITZERLAND 

      Info     : TW_STR32;   // e.g. "1.0b3 Beta release" 

      End

   pTW_VERSION = ^TW_VERSION; 

   PTWVersion  = pTW_VERSION; 

   TTWVersion  = TW_VERSION; 

 

Type 

   TW_IDENTITY = Packed record 

      Id              : TW_UINT32;  // Unique number. In Windows, 

                                    // application hWnd 

      Version         : TW_VERSION; // Identifies the piece of code 

      ProtocolMajor   : TW_UINT16;  // Application and DS must set to 

                                    // TWON_PROTOCOLMAJOR 

      ProtocolMinor   : TW_UINT16;  // Application and DS must set to 

                                    // TWON_PROTOCOLMINOR 

      SupportedGroups : TW_UINT32;  // Bit field OR combination of DG_ 

                                    // constants 

      Manufacturer    : TW_STR32;   // Manufacturer name, e.g. 

                                    // "Hewlett-Packard" 

      ProductFamily   : TW_STR32;   // Product family name, e.g. 

                                    // "ScanJet" 

      ProductName     : TW_STR32;   // Product name, e.g. "ScanJet Plus" 

      End

   pTW_IDENTITY = ^TW_IDENTITY; 

 

Type 

   // DAT_USERINTERFACE. Coordinates UI between application and data 

   // source 

   TW_USERINTERFACE = Packed record 

      ShowUI  : TW_BOOL;   // TRUE if DS should bring up its UI 

      ModalUI : TW_BOOL;   // For Mac only - true if the DS's UI is modal 

      hParent : TW_HANDLE; // For Windows only - Application handle 

      End

   pTW_USERINTERFACE = ^TW_USERINTERFACE; 

   TTWUserInterface  = TW_USERINTERFACE; 

   PTWUserInterface  = pTW_USERINTERFACE; 

 

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

//                                                                    // 

//                END OF TWAIN TYPES AND CONSTANTS                    // 

//                                                                    // 

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

 

Const 

   TWAIN_DLL_Name = 'TWAIN_32.DLL'

   DSM_Entry_Name = 'DSM_Entry'

   Ini_File_Name  = 'WIN.INI'

   CrLf           = #13 + #10

 

Resourcestring // Errorstrings: 

ERR_DSM_ENTRY_NOT_FOUND = 'Unable to find the entry of the Data ' + 

                          'Source Manager in: TWAIN_32.DLL'

ERR_TWAIN_NOT_LOADED    = 'Unable to load or find: TWAIN_32.DLL'

ERR_DSM_CALL_FAILED     = 'A call to the Data Source Manager failed ' + 

                          'in module %s'

ERR_UNKNOWN             = 'A call to the Data Source Manager failed ' + 

                          'in module %s: Code %.04x'

ERR_DSM_OPEN            = 'Unable to close the Data Source Manager. ' + 

                          'Maybe a source is still in use'

ERR_STATUS              = 'Unable to get the status'

ERR_DSM                 = 'Data Source Manager error in module %s:' + 

                          CrLf + '%s'

ERR_DS                  = 'Data Source error in module %s:' + 

                          CrLf + '%s'

 

Type 

   ETwainError = Class(Exception); 

   TImageType    = (ffTIFF,ffPICT,ffBMP,ffXBM,ffJFIF,ffFPX, 

                    ffTIFFMULTI,ffPNG,ffSPIFF,ffEXIF,ffUNKNOWN); 

   TTransferType = (xfNative,xfMemory,xfFile); 

   TLanguageType = (lgDutch,      lgEnglish, 

                    lgFrench,     lgGerman, 

                    lgAmerican,   lgItalian, 

                    lgSpanish,    lgNorwegian, 

                    lgFinnish,    lgDanish, 

                    lgRussian,    lgPortuguese, 

                    lgSwedish,    lgPolish, 

                    lgGreek,      lgTurkish); 

   TCountryType  = (ctNetherlands,ctEngland, 

                    ctFrance,     ctGermany, 

                    ctUSA,        ctSpain, 

                    ctItaly,      ctDenmark, 

                    ctFinland,    ctNorway, 

                    ctRussia,     ctPortugal, 

                    ctSweden,     ctPoland, 

                    ctGreece,     ctTurkey); 

   TTWAIN = Class(TComponent) 

   Private 

   // Private declarations 

      fBitmap                : TBitmap;     // the actual bmp used for 

                                            // scanning, must be 

                                            // removed 

      HDSMDLL                : HMODULE;     // = 0, the library handle: 

                                            // will stay global 

      appId                  : TW_IDENTITY; // our (Application) ID. 

                                            // (may stay global) 

      dsId                   : TW_IDENTITY; // Data Source ID (will 

                                            // become member of DS 

                                            // class) 

      fhWnd                  : HWND;        // = 0, maybe will be 

                                            // removed, use 

                                            // application.handle 

                                            // instead 

      fXfer                  : TTransferType; // = xfNative; 

      bDataSourceManagerOpen : Boolean;     // = False, flag, may stay 

                                            // global 

      bDataSourceOpen        : Boolean;     // = False, will become 

                                            // member of DS class 

      bDataSourceEnabled     : Boolean;     // = False, will become 

                                            // member of DS class 

      fScanReady             : TNotifyEvent; // notifies that the scan 

                                            // is ready 

      sDefaultSource         : String;      // remember old data source 

      fOldOnMessageHandler   : TMessageEvent; // Save old OnMessage event 

      fShowUI                : Boolean;     // Show User Interface 

      fSetupFileXfer         : TW_SETUPFILEXFER; // Not used yet 

      fSetupMemoryXfer       : TW_SETUPMEMXFER; // Not used yet 

      fMemory                : TW_MEMORY; // Not used yet 

 

      Function fLoadTwain : Boolean; 

      Procedure fUnloadTwain; 

      Function fNativeXfer : Boolean; 

      Function fMemoryXfer : Boolean; // Not used yet 

      Function fFileXfer : Boolean;   // Not used yet 

      Function fGetDestination : TTransferType; 

      Procedure fSetDestination(dest : TTransferType); 

      Function Condition2String(ConditionCode : TW_UINT16) : String; 

      Procedure RaiseLastDataSourceManagerCondition(module : String); 

      Procedure RaiseLastDataSourceCondition(module : String); 

      Procedure TwainCheckDataSourceManager(res    : TW_UINT16; 

                                            module : String); 

      Procedure TwainCheckDataSource(res     : TW_UINT16; 

                                     module  : string); 

 

      Function CallDataSourceManager(pOrigin : pTW_IDENTITY; 

                                     DG      : TW_UINT32; 

                                     DAT     : TW_UINT16; 

                                     MSG     : TW_UINT16; 

                                     pData   : TW_MEMREF) : TW_UINT16; 

 

      Function CallDataSource       (DG      : TW_UINT32; 

                                     DAT     : TW_UINT16; 

                                     MSG     : TW_UINT16; 

                                     pData   : TW_MEMREF) : TW_UINT16; 

 

      Procedure XferMech; 

      Procedure fSetProductname(pn : String); 

      Function fGetProductname : String; 

      Procedure fSetManufacturer(mf : String); 

      Function fGetManufacturer : String; 

      Procedure fSetProductFamily(pf : String); 

      Function fGetProductFamily : String; 

      Procedure fSetLanguage(lg : TLanguageType); 

      Function fGetLanguage : TLanguageType; 

      Procedure fSetCountry(ct : TCountryType); 

      Function fGetCountry : TCountryType; 

      Procedure SaveDefaultSourceEntry; 

      Procedure RestoreDefaultSourceEntry; 

      Procedure fSetCursor(cr : TCursor); 

      Function fGetCursor : TCursor; 

      Procedure fSetImageType(it : TImageType); 

      Function fGetImageType : TImageType; 

      Procedure fSetFilename(fn : String); 

      Function fGetFilename : String; 

      Procedure fSetVersionInfo(vi : String); 

      Function fGetVersionInfo : String; 

      Procedure fSetVersionMajor(vmaj : WORD); 

      Procedure fSetVersionMinor(vmin : WORD); 

      Function fGetVersionMajor : WORD; 

      Function fGetVersionMinor : WORD; 

 

   Protected 

      Procedure ScanReady; dynamic;  // Notifies when image transfer is 

                                     // ready 

      Procedure fNewOnMessageHandler(Var Msg : TMsg; 

         Var Handled : Boolean); virtual; 

 

   Public 

      // Public declarations 

      Constructor Create(AOwner : TComponent); override; 

      Destructor Destroy; override; 

      Procedure Acquire(aBmp : TBitmap); 

      Procedure OpenDataSource; 

      Procedure CloseDataSource; 

      Procedure InitTWAIN; 

      Procedure OpenDataSourceManager; 

      Procedure CloseDataSourceManager; 

      Function IsDataSourceManagerOpen : Boolean; 

      Procedure EnableDataSource; 

      // Procedure TWEnableDSUIOnly(ShowUI : Boolean); 

      Procedure DisableDataSource; 

      Function IsDataSourceOpen : Boolean; 

      Function IsDataSourceEnabled : Boolean; 

      Procedure SelectDataSource; 

      Function IsTwainDriverAvailable : Boolean; 

      Function ProcessSourceMessage(Var Msg : TMsg): Boolean; 

 

   Published 

      // Published declarations 

      // Properties, methods 

      Property Destination : TTransferType 

         Read fGetDestination write fSetDestination; 

      Property TwainDriverFound : Boolean 

         Read IsTwainDriverAvailable; 

      Property Productname : String 

         Read fGetProductname write fSetProductname; 

      Property Manufacturer : String 

         Read fGetManufacturer write fSetManufacturer; 

      Property ProductFamily : String 

         Read fGetProductFamily write fSetProductFamily; 

      Property Language : TLanguageType 

         Read fGetLanguage write fSetLanguage; 

      Property Country : TCountryType 

         Read fGetCountry write fSetCountry; 

      Property ShowUI : Boolean 

         Read fShowUI write fShowUI; 

      Property Cursor : TCursor 

         Read fGetCursor write fSetCursor; 

      Property FileFormat : TImageType 

         Read fGetImageType write fSetImageType; 

      Property Filename : String 

         Read fGetFilename write fSetFilename; 

      Property VersionInfo : String 

         Read fGetVersionInfo write fSetVersionInfo; 

      Property VersionMajor : WORD 

         Read fGetVersionMajor write fSetVersionMajor; 

      Property VersionMinor : WORD 

         Read fGetVersionMinor Write fSetVersionMinor; 

      // Events 

      Property OnScanReady : TNotifyEvent 

         Read fScanReady write fScanReady; 

   End

 

Procedure Register; 

 

Type 

   DSMENTRYPROC = Function(pOrigin : pTW_IDENTITY; 

                           pDest   : pTW_IDENTITY; 

                           DG      : TW_UINT32; 

                           DAT     : TW_UINT16; 

                           MSG     : TW_UINT16; 

                           pData   : TW_MEMREF) : TW_UINT16; stdcall; 

   TDSMEntryProc = DSMENTRYPROC; 

 

Type 

   DSENTRYPROC = Function( pOrigin : pTW_IDENTITY; 

                           DG      : TW_UINT32; 

                           DAT     : TW_UINT16; 

                           MSG     : TW_UINT16; 

                           pData   : TW_MEMREF) : TW_UINT16; stdcall; 

   TDSEntryProc = DSENTRYPROC; 

 

Var 

   DS_Entry  : TDSEntryProc  = nil; // Initialize 

   DSM_Entry : TDSMEntryProc = nil; // Initialize 

 

Implementation 

 

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

Constructor TTWAIN.Create(AOwner : TComponent); 

 

Begin 

Inherited Create(AOwner); 

// Initialize variables 

appID.Version.Info := 'Twain component'

appID.Version.Country := TWCY_USA; 

appID.Version.Language := TWLG_USA; 

appID.Productname := 'SimpelSoft TWAIN module';  // This is the one that you are 

                                                 // going to see in the UI 

appID.ManuFacturer := 'SimpelSoft'

appID.ProductFamily := 'SimpelSoft components'

appID.Version.MajorNum := 1

appID.Version.MinorNum := 0

// appID.ID := Application.Handle; 

 

fSetFilename('C:\TWAIN.BMP'); 

// fSetupFileXfer.FileName := 'C:\TWAIN.TMP': 

fSetImageType(ffBMP); 

// fSetupFileXfer.Format := TWFF_BMP; 

// fSetupFileXfer.VRefNum := xx; // For Mac 

// fSetupMemoryXfer.MinBufSize := xx; 

// fSetupMemoryXfer.MaxBufSize := yy; 

// fSetupMemoryXfer.Preferred := zz; 

fMemory.Flags := TWFF_BMP; 

// fMemory.Length := SizeOf(Mem); 

// fMemory.TheMem := @Mem; 

 

// fhWnd := Application.Handle; 

fShowUI := True; 

 

HDSMDLL := 0

sDefaultSource := ''

fXfer := xfNative; 

bDataSourceManagerOpen := False; 

bDataSourceOpen := False; 

bDataSourceEnabled := False; 

End

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

Destructor TTWAIN.Destroy; 

 

Begin 

If bDataSourceEnabled then 

   DisableDataSource; 

If bDataSourceOpen then 

   CloseDataSource; 

If bDataSourceManagerOpen then 

   CloseDataSourceManager; 

fUnLoadTwain;                 // Loose the TWAIN_32.DLL 

If sDefaultSource <> '' then 

   RestoreDefaultSourceEntry; // Write old entry back in WIN.INI 

Application.OnMessage := fOldOnMessageHandler; // Restore old OnMessage 

                                               // handler 

Inherited Destroy; 

End

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

Function TTWAIN.fGetVersionMajor : WORD; 

 

Begin 

Result := appID.Version.MajorNum; 

End

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

Function TTWAIN.fGetVersionMinor : WORD; 

 

Begin 

Result := appID.Version.MinorNum; 

End

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

Procedure TTWAIN.fSetVersionMajor(vmaj : WORD); 

 

Begin 

appID.Version.MajorNum := vmaj; 

End

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

Procedure TTWAIN.fSetVersionMinor(vmin : WORD); 

 

Begin 

appID.Version.MinorNum := vmin; 

End

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

Procedure TTWAIN.fSetVersionInfo(vi : String); 

 

Var 

   I,L : Integer; 

 

Begin 

FillChar(appID.Version.Info,SizeOf(appID.Version.Info),#0); 

L := Length(vi); 

If L = 0 then 

   Exit

If L > 32 then 

   L := 32

For I := 1 to L do 

   appID.Version.Info[I - 1] := vi[I]; 

End

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

Function TTWAIN.fGetVersionInfo : String; 

 

Var 

   I : Integer; 

 

Begin 

Result := ''

I := 0

If appID.Version.Info[I] <> #0 then 

   Repeat 

   Result := Result + appID.Version.Info[I]; 

   Inc(I); 

   Until appID.Version.Info[I] = #0

End

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

Procedure TTWAIN.fSetImageType(it : TImageType); 

 

Begin 

fSetupFileXfer.Format := TWFF_BMP; // Initialize 

fMemory.Flags := TWFF_BMP;         // Initialize 

 

Case it of 

   ffTIFF       : Begin 

                  fSetupFileXfer.Format := TWFF_TIFF; 

                  fMemory.Flags := TWFF_TIFF; 

                  End

   ffPICT       : Begin 

                  fSetupFileXfer.Format := TWFF_PICT; 

                  fMemory.Flags := TWFF_PICT; 

                  End

   ffBMP        : Begin 

                  fSetupFileXfer.Format := TWFF_BMP; 

                  fMemory.Flags := TWFF_BMP; 

                  End

   ffXBM        : Begin 

                  fSetupFileXfer.Format := TWFF_XBM; 

                  fMemory.Flags := TWFF_XBM; 

                  End

   ffJFIF       : Begin 

                  fSetupFileXfer.Format := TWFF_JFIF; 

                  fMemory.Flags := TWFF_JFIF; 

                  End

   ffFPX        : Begin 

                  fSetupFileXfer.Format := TWFF_FPX; 

                  fMemory.Flags := TWFF_FPX; 

                  End

   ffTIFFMULTI  : Begin 

                  fSetupFileXfer.Format := TWFF_TIFFMULTI; 

                  fMemory.Flags := TWFF_TIFFMULTI; 

                  End

   ffPNG        : Begin 

                  fSetupFileXfer.Format := TWFF_PNG; 

                  fMemory.Flags := TWFF_PNG; 

                  End

   ffSPIFF      : Begin 

                  fSetupFileXfer.Format := TWFF_SPIFF; 

                  fMemory.Flags := TWFF_SPIFF; 

                  End

   ffEXIF       : Begin 

                  fSetupFileXfer.Format := TWFF_EXIF; 

                  fMemory.Flags := TWFF_EXIF; 

                  End

   End

End

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

Procedure TTWAIN.fSetFilename(fn : String); 

 

Var 

   L,I : Integer; 

 

Begin 

FillChar(fSetupFileXfer.FileName,SizeOf(fSetupFileXfer.Filename),#0); 

L := Length(fn); 

If L > 0 then 

   For I := 1 to L do 

      fSetupFileXfer.Filename[I - 1] := fn[I]; 

End

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

Function TTWAIN.fGetFilename : String; 

 

Var 

   I : Integer; 

 

Begin 

Result := ''

I := 0

If fSetupFileXfer.Filename[I] <> #0 then 

   Repeat 

   Result := Result + fSetupFileXfer.Filename[I]; 

   Inc(I); 

   Until fSetupFileXfer.Filename[I] = #0

End

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

Function TTWAIN.fGetImageType : TImageType; 

 

Begin 

Result := ffUNKNOWN; // Initialize 

Case fSetupFileXfer.Format of 

   TWFF_TIFF      : Result := ffTIFF; 

   TWFF_PICT      : Result := ffPICT; 

   TWFF_BMP       : Result := ffBMP; 

   TWFF_XBM       : Result := ffXBM; 

   TWFF_JFIF      : Result := ffJFIF; 

   TWFF_FPX       : Result := ffFPX; 

   TWFF_TIFFMULTI : Result := ffTIFFMULTI; 

   TWFF_PNG       : Result := ffPNG; 

   TWFF_SPIFF     : Result := ffSPIFF; 

   TWFF_EXIF      : Result := ffEXIF; 

   End

End

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

Procedure TTWAIN.fSetCursor(cr : TCursor); 

 

Begin 

Screen.Cursor := cr; 

End

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

Function TTWAIN.fGetCursor : TCursor; 

 

Begin 

Result := Screen.Cursor

End

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

Procedure TTWAIN.fSetCountry(ct : TCountryType); 

 

Begin 

Case ct of 

   ctDenmark     : appID.Version.Country := TWCY_DENMARK; 

   ctNetherlands : appID.Version.Country := TWCY_NETHERLANDS; 

   ctEngland     : appID.Version.Country := TWCY_BRITAIN; 

   ctFinland     : appID.Version.Country := TWCY_FINLAND; 

   ctFrance      : appID.Version.Country := TWCY_FRANCE; 

   ctGermany     : appID.Version.Country := TWCY_GERMANY; 

   ctItaly       : appID.Version.Country := TWCY_ITALY; 

   ctNorWay      : appID.Version.Country := TWCY_NORWAY; 

   ctSpain       : appID.Version.Country := TWCY_SPAIN; 

   ctUSA         : appID.Version.Country := TWCY_USA; 

   ctRussia      : appID.Version.Country := TWCY_RUSSIA; 

   ctPortugal    : appID.Version.Country := TWCY_PORTUGAL; 

   ctSweden      : appID.Version.Country := TWCY_SWEDEN; 

   ctPoland      : appID.Version.Country := TWCY_POLAND; 

   ctGreece      : appID.Version.Country := TWCY_GREECE; 

   ctTurkey      : appID.Version.Country := TWCY_TURKEY; 

   End

End

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

Function TTWAIN.fGetCountry : TCountryType; 

 

Begin 

Result := ctNetherlands; // Initialize 

Case appID.Version.Country of 

   TWCY_NETHERLANDS : Result := ctNetherlands; 

   TWCY_DENMARK     : Result := ctDenmark; 

   TWCY_BRITAIN     : Result := ctEngland; 

   TWCY_FINLAND     : Result := ctFinland; 

   TWCY_FRANCE      : Result := ctFrance; 

   TWCY_GERMANY     : Result := ctGermany; 

   TWCY_NORWAY      : Result := ctNorway; 

   TWCY_ITALY       : Result := ctItaly; 

   TWCY_SPAIN       : Result := ctSpain; 

   TWCY_USA         : Result := ctUSA; 

   TWCY_RUSSIA      : Result := ctRussia; 

   TWCY_PORTUGAL    : Result := ctPortugal; 

   TWCY_SWEDEN      : Result := ctSweden; 

   TWCY_TURKEY      : Result := ctTurkey; 

   TWCY_GREECE      : Result := ctGreece; 

   TWCY_POLAND      : Result := ctPoland; 

   End

End

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

Procedure TTWAIN.fSetLanguage(lg : TLanguageType); 

 

Begin 

Case lg of 

   lgDanish     : appID.Version.Language := TWLG_DAN; 

   lgDutch      : appID.Version.Language := TWLG_DUT; 

   lgEnglish    : appID.Version.Language := TWLG_ENG; 

   lgFinnish    : appID.Version.Language := TWLG_FIN; 

   lgFrench     : appID.Version.Language := TWLG_FRN; 

   lgGerman     : appID.Version.Language := TWLG_GER; 

   lgNorwegian  : appID.Version.Language := TWLG_NOR; 

   lgItalian    : appID.Version.Language := TWLG_ITN; 

   lgSpanish    : appID.Version.Language := TWLG_SPA; 

   lgAmerican   : appID.Version.Language := TWLG_USA; 

   lgRussian    : appID.Version.Language := TWLG_RUSSIAN; 

   lgPortuguese : appID.Version.Language := TWLG_POR; 

   lgSwedish    : appID.Version.Language := TWLG_SWE; 

   lgPolish     : appID.Version.Language := TWLG_POLISH; 

   lgGreek      : appID.Version.Language := TWLG_GREEK; 

   lgTurkish    : appID.Version.Language := TWLG_TURKISH; 

   End

End

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

Function TTWAIN.fGetLanguage : TLanguageType; 

 

Begin 

Result := lgDutch; // Initialize 

Case appID.Version.Language of 

   TWLG_DAN     : Result := lgDanish; 

   TWLG_DUT     : Result := lgDutch; 

   TWLG_ENG     : Result := lgEnglish; 

   TWLG_FIN     : Result := lgFinnish; 

   TWLG_FRN     : Result := lgFrench; 

   TWLG_GER     : Result := lgGerman; 

   TWLG_ITN     : Result := lgItalian; 

   TWLG_NOR     : Result := lgNorwegian; 

   TWLG_SPA     : Result := lgSpanish; 

   TWLG_USA     : Result := lgAmerican; 

   TWLG_RUSSIAN : Result := lgRussian; 

   TWLG_POR     : Result := lgPortuguese; 

   TWLG_SWE     : Result := lgSwedish; 

   TWLG_POLISH  : Result := lgPolish; 

   TWLG_GREEK   : Result := lgGreek; 

   TWLG_TURKISH : Result := lgTurkish; 

   End

End

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

Procedure TTWAIN.fSetManufacturer(mf : String); 

 

Var 

   I,L : Integer; 

 

Begin 

FillChar(appID.Manufacturer,SizeOf(appID.Manufacturer),#0); 

L := Length(mf); 

If L = 0 then 

   Exit

If L > 32 then 

   L := 32

For I := 1 to L do 

   appID.Manufacturer[I - 1] := mf[I]; 

End

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

Function TTWAIN.fGetManufacturer : String; 

 

Var 

   I : Integer; 

 

Begin 

Result := ''

I := 0

If appID.Manufacturer[I] <> #0 then 

   Repeat 

   Result := Result + appID.Manufacturer[I]; 

   Inc(I); 

   Until appID.Manufacturer[I] = #0

End

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

Procedure TTWAIN.fSetProductname(pn : String); 

 

Var 

   I,L : Integer; 

 

Begin 

FillChar(appID.Productname,SizeOf(appID.Productname),#0); 

L := Length(pn); 

If L = 0 then 

   Exit

If L > 32 then 

   L := 32

For I := 1 to L do 

   appID.Productname[I - 1] := pn[I]; 

End

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

Function TTWAIN.fGetProductName : String; 

 

Var 

   I : Integer; 

 

Begin 

Result := ''

I := 0

If appID.ProductName[I] <> #0 then 

   Repeat 

   Result := Result + appID.ProductName[I]; 

   Inc(I); 

   Until appID.ProductName[I] = #0

End

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

Procedure TTWAIN.fSetProductFamily(pf : String); 

 

Var 

   I,L : Integer; 

 

Begin 

FillChar(appID.ProductFamily,SizeOf(appID.ProductFamily),#0); 

L := Length(pf); 

If L = 0 then 

   Exit

If L > 32 then 

   L := 32

For I := 1 to L do 

   appID.ProductFamily[I - 1] := pf[I]; 

End

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

Function TTWAIN.fGetProductFamily : String; 

 

Var 

   I : Integer; 

 

Begin 

Result := ''

I := 0

If appID.ProductFamily[I] <> #0 then 

   Repeat 

   Result := Result + appID.ProductFamily[I]; 

   Inc(I); 

   Until appID.ProductFamily[I] = #0

End

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

Procedure TTWAIN.ScanReady; 

 

Begin 

if Assigned(fScanReady) then 

   fScanReady(Self); 

End

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

Procedure TTWAIN.fSetDestination(dest : TTransferType); 

 

Begin 

fXfer := dest; 

End

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

Function TTWAIN.fGetDestination : TTransferType; 

 

Begin 

Result := fXfer; 

End

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

Function UpCaseStr(const s : String) : String; 

 

Var 

   I,L : Integer; 

 

Begin 

Result := s; 

L := Length(Result); 

If L > 0 then 

   Begin 

   For I := 1 to L do 

      Result[I] := UpCase(Result[I]); 

   End

// Result := s; // Minor bug, changed 23/05/03 

End

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

// Internal routine 

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

Function GetWinDir : String; 

 

Var 

   WD : Array[0..MAX_PATH] of Char; 

   L  : WORD; 

 

Begin 

WD := #0

GetWindowsDirectory(WD,MAX_PATH); 

Result := StrPas(WD); 

L := Length(Result); 

// Remove the "\" if any 

If L > 0 then 

   If Result[L] = '\' then 

      Result := Copy(Result,1,L - 1); 

End

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

// Internal routine 

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

Procedure FileFindSubDir(const ffsPath : String; 

                         var ffsBo     : Boolean); 

 

Var 

   sr      : TSearchRec; 

 

Begin 

If FindFirst(ffsPath + '\*.*',faAnyFile,sr) = 0 then 

   Repeat 

      If sr.Name <> '.' then 

         If sr.Name <> '..' then 

            If sr.Attr and faDirectory = faDirectory then 

               Begin 

               FileFindSubDir(ffsPath + '\' + sr.name,ffsBo); 

               End 

            else 

               Begin 

               If UpCaseStr(ExtractFileExt(sr.Name)) = '.DS' then 

                  If UpCaseStr(sr.Name) <> 'WIATWAIN.DS' then 

                     ffsBo := True; 

               End

   Until FindNext(sr) <> 0

// Error if SysUtils is not added in front of FindClose!   

SysUtils.FindClose(sr); 

End

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

Function TTWAIN.IsTwainDriverAvailable : Boolean; 

 

Var 

   sr      : TSearchRec; 

   s       : String; 

   Bo      : Boolean; 

 

Begin 

// This routine might not be failsafe! 

// Under circumstances the twain drivers found in the directory 

// %WINDOWS%\TWAIN_32\*.ds and below could be not properly installed! 

Bo := False; 

s := GetWinDir + '\TWAIN_32'

FileFindSubDir(s,Bo); 

Result := Bo; 

End

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

Procedure TTWAIN.SaveDefaultSourceEntry; 

 

Var 

   WinIni     : TIniFile; 

 

Begin 

If sDefaultSource <> '' then 

   Exit

WinIni := TIniFile.Create(Ini_File_Name); 

sDefaultSource := WinIni.ReadString('TWAIN','DEFAULT SOURCE',''); 

WinIni.Free; 

End

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

Procedure TTWAIN.RestoreDefaultSourceEntry; 

 

Var 

   WinIni     : TIniFile; 

 

Begin 

If sDefaultSource = '' then 

   Exit// It is not changed by this component or it is not there... 

WinIni := TIniFile.Create(Ini_File_Name); 

WinIni.WriteString('TWAIN','DEFAULT SOURCE',sDefaultSource); 

WinIni.Free; 

sDefaultSource := ''

End

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

Procedure TTWAIN.InitTWAIN; 

 

Begin 

appID.ID := Application.Handle; 

fHwnd := Application.Handle; 

fLoadTwain;                                    // Load TWAIN_32.DLL 

fOldOnMessageHandler := Application.OnMessage; // Save old pointer 

Application.OnMessage := fNewOnMessageHandler; // Set to our handler 

OpenDataSourceManager;                         // Open DS 

End

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

Function TTWAIN.fLoadTwain : Boolean; 

 

Begin 

If HDSMDLL = 0 then 

   Begin 

   HDSMDLL := LoadLibrary(TWAIN_DLL_Name); 

   DSM_Entry := GetProcAddress(HDSMDLL,DSM_Entry_Name); 

   // if @DSM_Entry = nil then 

   //   raise ETwainError.Create(SErrDSMEntryNotFound); 

   End

 

Result := (HDSMDLL <> 0); 

End

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

Procedure TTWAIN.fUnloadTwain; 

 

Begin 

If HDSMDLL <> 0 then 

   Begin 

   DSM_Entry := nil; 

   FreeLibrary(HDSMDLL); 

   HDSMDLL := 0

   End

End

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

Function TTWAIN.Condition2String(ConditionCode : TW_UINT16) : String; 

 

Begin 

// Texts copied from PDF Documentation: Rework needed 

Case ConditionCode of 

   TWCC_BADCAP          : Result := 

      'Capability not supported by source or operation (get,' + CrLf + 

      'set) is not supported on capability, or capability had' + CrLf + 

      'dependencies on other capabilities and cannot be' + CrLf + 

      'operated upon at this time'

   TWCC_BADDEST        : Result := 'Unknown destination in DSM_Entry.'

   TWCC_BADPROTOCOL    : Result := 'Unrecognized operation triplet.'

   TWCC_BADVALUE       : Result := 

      'Data parameter out of supported range.'

   TWCC_BUMMER         : Result := 

      'General failure. Unload Source immediately.'

   TWCC_CAPUNSUPPORTED : Result := 'Capability not supported by ' + 

      'Data Source.'

   TWCC_CAPBADOPERATION: Result := 'Operation not supported on ' + 

      'capability.'

   TWCC_CAPSEQERROR    : Result := 

      'Capability has dependencies on other capabilities and ' + CrLf + 

      'cannot be operated upon at this time.'

   TWCC_DENIED         : Result := 

      'File System operation is denied (file is protected).'

   TWCC_PAPERDOUBLEFEED, 

   TWCC_PAPERJAM       : Result := 

      'Transfer failed because of a feeder error'

   TWCC_FILEEXISTS     : Result := 

      'Operation failed because file already exists.'

   TWCC_FILENOTFOUND   : Result := 'File not found.'

   TWCC_LOWMEMORY      : Result := 

      'Not enough memory to complete the operation.'

   TWCC_MAXCONNECTIONS : Result := 

      'Data Source is connected to maximum supported number of ' + 

      CrLf + 'applications.'

   TWCC_NODS           : Result := 

      'Data Source Manager was unable to find the specified Data ' + 

      'Source.'

   TWCC_NOTEMPTY       : Result := 

      'Operation failed because directory is not empty.'

   TWCC_OPERATIONERROR : Result := 

      'Data Source or Data Source Manager reported an error to the' + 

      CrLf + 'user and handled the error. No application action ' + 

      'required.'

   TWCC_SEQERROR       : Result := 

      'Illegal operation for current Data Source Manager' + CrLf + 

      'and Data Source state.'

   TWCC_SUCCESS        : Result := 'Operation was succesful.'

else 

    Result := Format('Unknown condition %.04x',[ConditionCode]); 

    End

End

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

// RaiseLastDSMCondition (idea: like RaiseLastWin32Error)            // 

// Tries to get the status from the DSM and raises an exception      // 

// with it.                                                          // 

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

Procedure TTWAIN.RaiseLastDataSourceManagerCondition(module : String); 

 

Var 

   status : TW_STATUS; 

 

Begin 

Assert(@DSM_Entry <> nil); 

If DSM_Entry(@appId,nil,DG_CONTROL,DAT_STATUS,MSG_GET,@status) <> 

   TWRC_SUCCESS then 

   Raise ETwainError.Create(ERR_STATUS) 

else 

   Raise ETwainError.CreateFmt(ERR_DSM,[module, 

      Condition2String(status.ConditionCode)]); 

End

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

// RaiseLastDSCondition                                              // 

// same again, but for the actual DS                                 // 

// (should be a method of DS)                                        // 

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

Procedure TTWAIN.RaiseLastDataSourceCondition(module : String); 

 

Var 

   status : TW_STATUS; 

 

Begin 

Assert(@DSM_Entry <> nil); 

If DSM_Entry(@appId,@dsID,DG_CONTROL,DAT_STATUS,MSG_GET,@status) <> 

   TWRC_SUCCESS then 

   Raise ETwainError.Create(ERR_STATUS) 

else 

   Raise ETwainError.CreateFmt(ERR_DSM,[module, 

      Condition2String(status.ConditionCode)]); 

End

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

// TwainCheckDSM (idea: like Win32Check or GDICheck in Graphics.pas) // 

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

Procedure TTWAIN.TwainCheckDataSourceManager(res    : TW_UINT16; 

                                             module : String); 

 

Begin 

If res <> TWRC_SUCCESS then 

   Begin 

   If res = TWRC_FAILURE then 

      RaiseLastDataSourceManagerCondition(module) 

   else 

      Raise ETwainError.CreateFmt(ERR_UNKNOWN,[module,res]); 

   End

End

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

// TwainCheckDS                                                      // 

// same again, but for the actual DS                                 // 

// (should be a method of DS)                                        // 

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

Procedure TTWAIN.TwainCheckDataSource(res    : TW_UINT16; 

                                      module : string); 

 

Begin 

If res <> TWRC_SUCCESS then 

   Begin 

   If res = TWRC_FAILURE then 

      RaiseLastDataSourceCondition(module) 

   else 

      Raise ETwainError.CreateFmt(ERR_UNKNOWN,[module,res]); 

   End

End

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

// CallDSMEntry:                                                     // 

// Short form for DSM Calls: appId is not needed as parameter        // 

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

Function TTWAIN.CallDataSourceManager(pOrigin : pTW_IDENTITY; 

                                      DG      : TW_UINT32; 

                                      DAT     : TW_UINT16; 

                                      MSG     : TW_UINT16; 

                                      pData   : TW_MEMREF) : TW_UINT16; 

 

Begin 

Assert(@DSM_Entry <> nil); 

 

Result := DSM_Entry(@appID, 

                    pOrigin, 

                    DG, 

                    DAT, 

                    MSG, 

                    pData); 

If (Result <> TWRC_SUCCESS) and (DAT <> DAT_EVENT) then 

   Begin 

   End

End

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

// Short form for (actual) DS Calls. appId and dsID are not needed   // 

// (this should be a DS class method)                                // 

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

Function TTWAIN.CallDataSource(DG    : TW_UINT32; 

                               DAT   : TW_UINT16; 

                               MSG   : TW_UINT16; 

                               pData : TW_MEMREF) : TW_UINT16; 

 

Begin 

Assert(@DSM_Entry <> nil); 

Result := DSM_Entry(@appID, 

                    @dsID, 

                    DG, 

                    DAT, 

                    MSG, 

                    pData); 

End

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

//  A lot of the following code is a conversion from the             // 

//  twain example program (and some comments are copied, too)        // 

//  (The error handling is done differently)                         // 

//  Most functions should be moved to a DSM or DS class              // 

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

Procedure TTWAIN.OpenDataSourceManager; 

 

Begin 

If not bDataSourceManagerOpen then 

   Begin 

   Assert(appID.ID <> 0); 

   If not fLoadTwain then 

      Raise ETwainError.Create(ERR_TWAIN_NOT_LOADED); 

 

   // appID.Id := fhWnd; 

   // appID.Version.MajorNum := 1; 

   // appID.Version.MinorNum := 0; 

   // appID.Version.Language := TWLG_USA; 

   // appID.Version.Country  := TWCY_USA; 

   // appID.Version.Info     := 'Twain Component'; 

   appID.ProtocolMajor    := 1// TWON_PROTOCOLMAJOR; 

   appID.ProtocolMinor    := 7// TWON_PROTOCOLMINOR; 

   appID.SupportedGroups  := DG_IMAGE or DG_CONTROL; 

   // appID.Productname      := 'HP ScanJet 5p'; 

   // appId.ProductFamily    := 'ScanJet'; 

   // appId.Manufacturer     := 'Hewlett-Packard'; 

 

   TwainCheckDataSourceManager(CallDataSourceManager(nil, 

                                                     DG_CONTROL, 

                                                     DAT_PARENT, 

                                                     MSG_OPENDSM, 

                                                     @fhWnd), 

                                               'OpenDataSourceManager'); 

 

   bDataSourceManagerOpen := True; 

   End

End

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

Procedure TTWAIN.CloseDataSourceManager; 

 

Begin 

If bDataSourceOpen then 

   Raise ETwainError.Create(ERR_DSM_OPEN); 

 

If bDataSourceManagerOpen then 

   Begin 

   // This call performs one important function: 

   // - tells the SM which application, appID.id, is requesting SM to 

   //   close 

   // - be sure to test return code, failure indicates SM did not 

   //   close !! 

 

   TwainCheckDataSourceManager(CallDataSourceManager(nil, 

                                                     DG_CONTROL, 

                                                     DAT_PARENT, 

                                                     MSG_CLOSEDSM, 

                                                     @fhWnd), 

                                              'CloseDataSourceManager'); 

 

   bDataSourceManagerOpen := False; 

 

   End

fUnLoadTwain; // Loose the DLL 

 

If sDefaultSource <> '' then 

   RestoreDefaultSourceEntry; 

 

End

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

Function TTWAIN.IsDataSourceManagerOpen : Boolean; 

 

Begin 

Result := bDataSourceManagerOpen; 

End

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

Procedure TTWAIN.OpenDataSource; 

 

Begin 

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

 

If not bDataSourceOpen then 

   Begin 

   TwainCheckDataSourceManager(CallDataSourceManager(nil, 

                                                     DG_CONTROL, 

                                                     DAT_IDENTITY, 

                                                     MSG_OPENDS, 

                                                     @dsID), 

                                                     'OpenDataSource'); 

   bDataSourceOpen := True; 

   End

End

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

Procedure TTWAIN.CloseDataSource; 

 

Begin 

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

If bDataSourceOpen then 

   Begin 

   TwainCheckDataSourceManager(CallDataSourceManager(nil, 

                                                     DG_CONTROL, 

                                                     DAT_IDENTITY, 

                                                     MSG_CLOSEDS, 

                                                     @dsID), 

                                                     'CloseDataSource'); 

   bDataSourceOpen := False; 

   End

End

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

Procedure TTWAIN.EnableDataSource; 

 

Var 

   twUI : TW_USERINTERFACE; 

 

Begin 

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

 

If not bDataSourceEnabled then 

   Begin 

   FillChar(twUI,SizeOf(twUI),#0); 

 

   twUI.hParent := fhWnd; 

   twUI.ShowUI  := fShowUI; 

   twUI.ModalUI := True; 

 

   TwainCheckDataSourceManager(CallDataSourceManager(@dsID, 

                                                     DG_CONTROL, 

                                                     DAT_USERINTERFACE, 

                                                     MSG_ENABLEDS, 

                                                     @twUI), 

                                                    'EnableDataSource'); 

 

   bDataSourceEnabled := True; 

   End

End

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

Procedure TTWAIN.DisableDataSource; 

 

Var 

   twUI : TW_USERINTERFACE; 

 

Begin 

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

 

If bDataSourceEnabled then 

   Begin 

   twUI.hParent := fhWnd; 

   twUI.ShowUI := TW_BOOL(TWON_DONTCARE8); (*!!!!*) 

 

   TwainCheckDataSourceManager(CallDataSourceManager(@dsID, 

                                                     DG_CONTROL, 

                                                     DAT_USERINTERFACE, 

                                                     MSG_DISABLEDS, 

                                                     @twUI), 

                                                   'DisableDataSource'); 

 

   bDataSourceEnabled := False; 

   End

End

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

Function TTWAIN.IsDataSourceOpen : Boolean; 

 

Begin 

Result := bDataSourceOpen; 

End

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

Function TTWAIN.IsDataSourceEnabled : Boolean; 

 

Begin 

Result := bDataSourceEnabled; 

End

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

Procedure TTWAIN.SelectDataSource; 

 

Var 

   NewDSIdentity : TW_IDENTITY; 

   twRC          : TW_UINT16; 

 

Begin 

SaveDefaultSourceEntry; 

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

 

TwainCheckDataSourceManager(CallDataSourceManager(nil, 

                                                  DG_CONTROL, 

                                                  DAT_IDENTITY, 

                                                  MSG_GETDEFAULT, 

                                                  @NewDSIdentity), 

                                                  'SelectDataSource1'); 

 

   twRC := CallDataSourceManager(nil, 

                                 DG_CONTROL, 

                                 DAT_IDENTITY, 

                                 MSG_USERSELECT, 

                                 @NewDSIdentity); 

 

   Case twRC of 

      TWRC_SUCCESS : dsID := NewDSIdentity; // log in new Source 

      TWRC_CANCEL  :      ;                 // keep the current Source 

   else 

      TwainCheckDataSourceManager(twRC,'SelectDataSource2'); 

      End

End

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

  Functions from CAPTEST.C 

*******************************************************************) 

Procedure TTWAIN.XferMech; 

 

Var 

   cap        : TW_CAPABILITY; 

   pVal       : pTW_ONEVALUE; 

 

Begin 

fXfer := xfNative; // Override 

cap.Cap := ICAP_XFERMECH; 

cap.ConType := TWON_ONEVALUE; 

cap.hContainer := GlobalAlloc(GHND,SizeOf(TW_ONEVALUE)); 

Assert(cap.hContainer <> 0); 

Try 

   pval := pTW_ONEVALUE(GlobalLock(cap.hContainer)); 

   Assert(pval <> nil); 

   Try 

      pval.ItemType := TWTY_UINT16; 

      Case fXfer of 

         xfMemory : pval.Item := TWSX_MEMORY; 

         xfFile   : pval.Item := TWSX_FILE; 

         xfNative : pval.Item := TWSX_NATIVE; 

         End

   Finally 

      GlobalUnlock(cap.hContainer); 

      End

 

   TwainCheckDataSource(CallDataSource(DG_CONTROL, 

                                       DAT_CAPABILITY, 

                                       MSG_SET

                                       @cap), 

                                       'XferMech'); 

 

Finally 

   GlobalFree(cap.hContainer); 

   End

 

End

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

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

 

Var 

   twRC        : TW_UINT16; 

   event       : TW_EVENT; 

   pending     : TW_PENDINGXFERS; 

 

Begin 

Result := False; 

 

If bDataSourceManagerOpen and bDataSourceOpen then 

   Begin 

   event.pEvent := @Msg; 

   event.TWMessage := 0

 

   twRC := CallDataSource(DG_CONTROL, 

                          DAT_EVENT, 

                          MSG_PROCESSEVENT, 

                          @event); 

 

   Case event.TWMessage of 

      MSG_XFERREADY  : Begin 

                       Case fXfer of 

                          xfNative : fNativeXfer; 

                          xfMemory : fMemoryXfer; 

                          xfFile   : fFileXfer; 

                          End

                       TwainCheckDataSource(CallDataSource(DG_CONTROL, 

                                                       DAT_PENDINGXFERS, 

                                                           MSG_ENDXFER, 

                                                           @pending), 

                                         'Check for Pending Transfers'); 

 

                       If pending.Count > 0 then 

                          TwainCheckDataSource(CallDataSource( 

                                                       DG_CONTROL, 

                                                       DAT_PENDINGXFERS, 

                                                       MSG_RESET, 

                                                       @pending), 

                                             'Abort Pending Transfers'); 

 

                       DisableDataSource; 

                       CloseDataSource; 

                       ScanReady; // Event 

                       End

      MSG_CLOSEDSOK, 

      MSG_CLOSEDSREQ : Begin 

                       DisableDataSource; 

                       CloseDataSource; 

                       ScanReady // Event 

                       End

      End

 

   Result := not (twRC = TWRC_NOTDSEVENT); 

   End

End

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

Procedure TTWAIN.Acquire(aBmp : TBitmap); 

 

Begin 

// fOldOnMessageHandler := Application.OnMessage; // Save old pointer 

// Application.OnMessage := fNewOnMessageHandler; // Set to our handler 

// OpenDataSourceManager;                         // Open DS 

fBitmap := aBmp; 

OpenDataSourceManager; 

OpenDataSource; 

XferMech; // Must be written for xfMemory and xfFile 

EnableDataSource; 

End

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

// Must be written! 

Function TTWAIN.fMemoryXfer : Boolean; 

 

Var 

   twRC : TW_UINT16; 

 

Begin 

Result := False; 

twRC := CallDataSource(DG_IMAGE, 

                       DAT_IMAGEMEMXFER, 

                       MSG_GET, 

                       nil); 

Case twRC of 

   TWRC_XFERDONE : Result := True; 

   TWRC_CANCEL   : ; 

   TWRC_FAILURE  : ; 

   End

End

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

// Must be written! 

Function TTWAIN.fFileXfer : Boolean; 

 

Var 

   twRC : TW_UINT16; 

 

Begin 

// Not yet implemented! 

Result := False; 

twRC := CallDataSource(DG_IMAGE, 

                       DAT_IMAGEFILEXFER, 

                       MSG_GET, 

                       nil); 

Case twRC of 

   TWRC_XFERDONE : Result := True; 

   TWRC_CANCEL   : ; 

   TWRC_FAILURE  : ; 

   End

End

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

Function TTWAIN.fNativeXfer : Boolean; 

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

   Function DibNumColors(dib : Pointer) : Integer; 

 

   Var 

      lpbi   : PBITMAPINFOHEADER; 

      lpbc   : PBITMAPCOREHEADER; 

      bits   : Integer; 

 

   Begin 

   lpbi := dib; 

   lpbc := dib; 

 

   If lpbi.biSize <> SizeOf(BITMAPCOREHEADER) then 

      Begin 

      If lpbi.biClrUsed <> 0 then 

         Begin 

         Result := lpbi.biClrUsed; 

         Exit

         End

      bits := lpbi.biBitCount; 

      End 

   else 

      bits := lpbc.bcBitCount; 

 

   Case bits of 

      1  :  Result := 2

      4  :  Result := 16;  // 4? 

      8  :  Result := 256// 8? 

   else 

      Result := 0

      End

   End

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

Var 

   twRC                  : TW_UINT16; 

   hDIB                  : TW_UINT32; 

   hBmp                  : HBITMAP; 

   lpDib                 : ^TBITMAPINFO; 

   lpBits                : PChar; 

   ColorTableSize        : Integer; 

   dc                    : HDC; 

 

Begin 

Result := False; 

 

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

 

Case twRC of 

   TWRC_XFERDONE : Begin 

                   lpDib := GlobalLock(hDIB); 

                   Try 

                      ColorTableSize := (DibNumColors(lpDib) * 

                         SizeOf(RGBQUAD)); 

 

                      lpBits := PChar(lpDib); 

                      Inc(lpBits,lpDib.bmiHeader.biSize); 

                      Inc(lpBits,ColorTableSize); 

 

                      dc := GetDC(0); 

                      Try 

                         hBMP := CreateDIBitmap(dc,lpdib.bmiHeader, 

                            CBM_INIT,lpBits,lpDib^,DIB_RGB_COLORS); 

 

                         fBitmap.Handle := hBMP; 

 

                         Result := True; 

                      Finally 

                         ReleaseDC(0,dc); 

                         End

                   Finally 

                      GlobalUnlock(hDIB); 

                      GlobalFree(hDIB); 

                      End

                   End

   TWRC_CANCEL  : ; 

   TWRC_FAILURE : RaiseLastDataSourceManagerCondition('Native Transfer'); 

   End

End

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

Procedure TTWAIN.fNewOnMessageHandler(Var Msg : TMsg; 

   Var Handled : Boolean); 

 

Begin 

Handled := ProcessSourceMessage(Msg); 

If Assigned(fOldOnMessageHandler) then 

   fOldOnMessageHandler(Msg,Handled) 

End

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

Procedure Register; 

 

Begin 

RegisterComponents('Samples',[TTWAIN]); 

End

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

End

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