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

=== Как работать со сканером? ===
Исходники модуля TWAIN.pas (нажмите "Развернуть") ->
 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;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 01616
----
The setup program for Imaging (tool that ships with Windows > 98) installs the Image
Scan control (OCX) and the 32-bit TWAIN DLLs.
All you have to do is to import this ActiveX control in Delphi and generate a component wrapper:
Import the ActiveX Control "Kodak Image Scan Control"
(Select Component|Import ActiveX Control...)
Now add a TImgScan Component from the Register "ActiveX" to your form.
Change the following Properties in the Object Inspector:
FileType = 3 - BMP_Bitmap
PageOption = 4 - OverwritePages
ScanTo = 2 - FileOnly
FileType = 3 - BMP_Bitmap
PageOption = 4 - OverwritePages
ScanTo = 2 - FileOnly
{***}
 procedure TForm1.Button1Click(Sender: TObject);
 begin
 if imgScan1.ScannerAvailable then
 try
 imgScan1.Image := 'c:\Scanner.bmp';
 imgScan1.OpenScanner;
 imgScan1.Zoom := 100;
 imgScan1.StartScan;
 Application.ProcessMessages;
 finally
 imgScan1.CloseScanner;
 { Show the scanned image in Image1 }
 imgScan1.Picture.LoadFromFile(Image1.Image);
 end;
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
----
=== TWAIN ===
В настоящее время в конференциях то и дело встречаются вопросы типа: как мне получить изображение со сканера, с web камеры и т.д.. При том, что и интернете практически полностью отсутствуют материалы по этим вопросам на русском языке и при достаточном разнообразии их на английском. Эта статья должна помочь начинающему программисту на Delphi разобраться в них. В статье подробно, с примерами описана работа со сканером с использованием популярной библиотеки Easy TWAIN. 
==== Введение ====
В отличие от принтеров сканеры изначально не поддерживались ОС Windows и не имеют API для работы с ними. В начале своего появления сканеры взаимодействовали с программами посредством уникального для каждой модели сканера интерфейса, что серьезно затрудняло включение поддержки работы со сканером в прикладные программы. 
Для решения этой проблемы был разработан TWAIN - индустриальный стандарт интерфейса программного обеспечения для передачи изображений из различных устройств в Windows и Macintosh. Стандарт издан и поддерживается TWAIN рабочей группой - официальный сайт www.twain.org. Стандарт издан в 1992 г. В настоящее время действует версия 1.9 от января 2000 г. Абревеатура TWAIN изначально не имела какого-то определенного смысла хотя позже была придумана расшифровка: (Technology Without An Interesting Name - Технология без интересного имени). TWAIN - не протокол аппаратного уровня, он требует драйвера (названного Data Source или DS) для каждого устройства. 
К настоящему времени (май 2000 г.) TWAIN доступен для Windows 3.1 и выше (Intel и совместимые процессоры), Macintosh и OS/2. Для Linux самый близкий стандарт - SANE. 
Менеджер TWAIN (DSM) - действует как координатор между приложениями и Источником Данных (Data Source). DSM имеет минимальный пользовательский интерфейс - только выбор DS. Все взаимодействие с пользователем вне прикладной программы осуществляется по средствам DS. 
Каждый источник данных разрабатывается непосредственно производителем соответствующих устройств. И их поддержка стандарта TWAIN осуществляется на добровольной основе. 
==== Использование TWAIN ====
DSM и DS это DLLs загружаемые в адресное пространство приложения и работают как подпрограммы приложения. DSM использует межпроцесcную связь, что бы координировать действия со своими копиями, когда больше чем одна программа использует TWAIN. 
Упрощенная схема действия приложения использующего TWAIN: 
* Открыть диалог настройки соответствующего устройства (диалог отображает DS) и задать соответствующие настройки. 
* Приложение ожидает сообщение от DS, что изображение готово. Во время ожидания все зарегистрированные сообщения будут направляться через TWAIN. Если это не будет выполняться, то приложение не получит сообщения о готовности изображения. 
* Приложение принимает изображение от DS.
* TWAIN определяет три типа передачи изображения:
** Native - в Windows это DIB в памяти 
** Memory - как блоки пикселей в буферах памяти 
** File - DS записывает изображение непосредственно в файл (не обязательно поддерживается) 
* Приложение закрывает DS. 
==== Использование EZTWAIN ====
Данная библиотека была разработана, что бы упростить разработку программ использующих TWAIN предоставляя разработчику упрощенную версию TWAIN API. 
EZTWAN обеспечивает передачу всех windows сообщений через TWAIN и ожидает сообщения о готовности изображения. 
Библиотека EZTWAIN является свободно распространяемой библиотекой с открытыми исходными кодами. В настоящее время выпущена версия 1.12. Библиотеку можно свободно скачать с сайта: www.dosadi.com, библиотека написана на C и предназначена для использования как DLL, необходимый для ее использования с Delphi модуль так же можно скачать с сайта. Кроме нее у меня с сайта можно скачать модификацию данной библиотеки, предназначенную для статической компоновки с программой на Delphi. Указанная версия (MultiTWAIN for Delphi) не требует наличия библиотеки EZTW32.DLL. 
==== Структура программы ====
Используемые функции. 
Перед вызовом функций сканирования необходимо вызвать функцию:
 TWAIN_SelectImageSource(hwnd: HWND): Integer; 
Данная функция позволяет выбрать источник получения данных из списка TWAIN совместимых устройств, в качестве параметра она получает хендл основного окна прикладной программы. Следует заменить, что если в системе имеется одно TWAIN совместимое устройство, то вызывать функцию не обязательно. 
Для получения изображения служит функция:
 TWAIN_AcquireNative(hwnd: HWND; pixmask: Integer): HBitmap; 
где: 
* hwnd - хендел основного окна прикладной программы (допускается указывать 0);
* pixmask - режим сканирования ( необходимо задавать 0 - указание другого режима может приводить к ошибке);
* hBitmap - указатель на область памяти, содержащей полученные данные в DIB формате. 
По окончании работы с DIB данными их необходимо удалить вызвав процедуру:
 TWAIN_FreeNative(hDIB: HBitmap); 
где:
* hDIB - указатель, полученный при вызове функции TWAIN_AcquireNative. 
Для облегчения обработки полученных DIB данных в библиотеке имеется несколько сервисных функций: 
// Получает ширину изображения в пикселях
TWAIN_DibWidth(hDib: HBitmap): Integer;
// Получает высоту изображения в пикселях
TWAIN_DibHeight(hDib: HBitmap): Integer;
// Получает цветовую палитру изображения
TWAIN_CreateDibPalette(hdib: HBitmap): Integer;
// Передает DIB данные в формате совместимым
// с указанным контекстом устройства.
TWAIN_DrawDibToDC(hDC: HDC;
 dx, dy, w, h: Integer;
 hDib: HBitmap;
 sx, sy: Integer);
==== Пример программы ====
Полный текст примера можно взять отсюда. Мы рассмотрим только функцию получения данных с TWAIN устройства: 
procedure TForm1.Accquire1Click(Sender: TObject);
var
 dat: hBitMap;
 PInfo: PBitMapInfoHeader;
 Height, Width: integer;
 {Функция возведения 2 в степень s}
 function stp2(s: byte): longint;
 var
 m: longint;
 i: byte;
 begin
 m := 2;
 for i := 2 to s do
 m := m * 2;
 stp2 := m;
 end;
begin
 { Получаем указатель на графические данные }
 dat := TWAIN_AcquireNative(Handle, 0);
 if dat <> 0 then
 begin
 { Получаем указатель на область памяти содержащей DIB
 данные и блокируем область памяти }
 PInfo := GlobalLock(dat);
 { Анализируем полученные данные }
 Height := PInfo.biHeight;
 Width := PInfo.biWidth;
 { Узнаем размер полученного изображения в сантиметрах }
 Wcm.Caption := floatToStrF(100 / PInfo.biXPelsPerMeter * Width, ffNumber, 8,
 3)
 + ' cm';
 Hcm.Caption := floatToStrF(100 / PInfo.biYPelsPerMeter * Height, ffNumber,
 8, 3)
 + ' cm';
 { Определяем число цветов в изображении }
 Colors.Caption := floatToStrF(stp2(PInfo.biBitCount), ffNumber, 8, 0) +
 ' цветов';
 { Разблокируем память }
 GlobalUnlock(dat);
 { Передаем в битовую матрицу графические данные }
 { И устанавливаем перехват ошибок }
 try
 MyBitMap.Palette := TWAIN_CreateDibPalette(dat);
 MyBitMap.Width := Width;
 MyBitMap.Height := Height;
 TWAIN_DrawDibToDC(MyBitMap.Canvas.Handle, 0, 0, Width, Height, dat, 0, 0);
 except
 // Обрабатываем наиболее вероятную ошибку связанную
 // с не хваткой ресурсов для загрузки изображения
 on EOutOFResources do
 MessageDlg('TBitMap: Нет ресурсов для загрузки изображения!',
 mtError, [mbOk], 0);
 end;
 { Отображаем графические данные }
 Image1.Picture.Graphic := MyBitMap;
 { Освобождаем память занятую графическими данными }
 TWAIN_FreeNative(dat);
 end;
end;
Обработка ошибок необходима, так как объект TBitMap имеет серьезные ограничения на размер создаваемого изображения. При этом производится обработка наиболее вероятной ошибки, в случае возникновения другой ошибки, ее обработка будет передана обработчику по умолчанию. Обработка ошибки в данном случае заключается в выдаче диагностического сообщения, в прикладной программе можно реализовать выполнение любых необходимых действий, например, произвести уменьшение разрешения и повторно подать на загрузку в TBitMap. 
==== Заключение ====
Приведенный здесь пример тестировался на сканере Umax 2000P с драйвером VistaScan32 V3.52. При получении изображений следует помнить, что максимальный размер блока памяти, который может распределить Windows, составляет 2 Гб и при попытке сканировании страниц формата А4 с высоким разрешением можно превысить этот предел. Кроме того, достаточно простой в обращении объект TBitMap имеет куда более серьезные ограничения на размер загружаемых изображений, что требует непосредственной работы с DIB данными. Но это уже тема для отдельной статьи. Если у Вас появились вопросы или предложения пишите мне: speclab@4unet.ru 
Source: http://delphiworld.narod.ru/
ID: 01617
Category:Статьи