I've used this code and work fine with FW804 and xHabour 1.1.0. Now I upgrade to FWH907 with xHb 1.2.1. It doesn't work and got GPF error. Have anyone got this problem?
- Code: Select all Expand view
- /*------------------------------------------------------------------------*
ฺฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฟ
ณ ณ
ณ ProcName......: Scanner.prg ณ
ณ Pourpose......: TWAIN standard device Class interface ณ
ณ Date..........: 05-11-96 ณ
ณ Author........: (c),L.Gadaleta ณ
ณ ณ
ภฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤู
*------------------------------------------------------------------------*/
#include "FiveWin.ch"
#include "Image.ch"
#define STAND_ALONE
#define TWAIN_DLL "EZTw32.dll"
#define CBM_INIT 4 // for freeimage.dll
#define DIB_RGB_COLORS 0 // for freeimage.dll
STATIC hLib // for freeimage.dll
STATIC oWnd, oImage
#ifdef STAND_ALONE
*----------------------*
FUNCTION ScanMe(cFileRes)
LOCAL cFile, nRes, n
Default cFileRes := 'TESTSCAN.JPG'
cFile := cFileRes
nRes := 100
if !cFileRes == NIL
if ( n:=AT(",",cFileRes) ) > 0
cFile := Alltrim(Substr(cFileRes,1,n-1))
nRes := Val(Alltrim(Substr(cFileRes,n+1)))
end
end
CursorWait()
DEFINE WINDOW oWnd FROM 1,1 TO 1,1
ACTIVATE WINDOW oWnd ON INIT (oWnd:Hide(), ;
RunScan(cFile,oWnd:hWnd,nRes))
if file( cFile )
SaveImage( cFile )
end
CursorArrow()
RETURN NIL
STATIC FUNCTION RunScan(cFile,hWnd,nRes)
LOCAL oScanner := Scanner():New(hWnd)
DEFAULT nRes := 100 // Scanner resolution in Dpi
oScanner:Choose()
oScanner:Set(.T.) // Set User Interface Off
oScanner:DigiToFile(cFile,nRes) // Acquires
oScanner:End()
oWnd:End()
RETURN NIL
#endif
CLASS Scanner
DATA hWnd AS NUMERIC // Handle of the window
DATA hDll AS NUMERIC // Handle of the DLL
DATA lLoad AS LOGICAL // .T. DLL & Driver Loaded
DATA hDib AS NUMERIC // Current Dib handle
*
METHOD New() CONSTRUCTOR
METHOD End()
METHOD Set() // Acquiring Dialog ON/OFF
METHOD Choose() // Select Image Device Source
METHOD DigiToFile() // Acquire Image and save to a file
METHOD DigiToClip() // Acquire Image and copy to ClipBoard
METHOD SetResolution() // Set Dpi for the scanner
*
PROTECTED :
METHOD Free() // Release Dib's handle
METHOD IsActive() // Twain Driver Loaded
METHOD Register() // Register my application into Twain application
METHOD DibToFile() // Write to file Dib's handle in BMP format
END CLASS
METHOD New(hWnd)
// Constructor
::hWnd := iif( ValType( hWnd ) == "N" , hWnd , 0 )
::lLoad := .T.
::hDLL := LoadLibrary( TWAIN_DLL )
::hDib := 0
if ::hDll <= 21
::lLoad := .F.
MsgAlert( BuildError(::hDll) , TWAIN_DLL )
RETU Self
end
if ( ::lLoad := ::IsActive() )
::Register()
end
RETU Self
METHOD End()
// Destructor
if ::hDib != 0
::Free( ::hDib )
end
FreeLibrary( ::hDll )
RETU NIL
METHOD DigiToFile( cFile , nRes )
// Acquire Document & save to file
LOCAL nPixType := 0
LOCAL cFarProc
DEFAULT nRes := 100
::SetResolution( nRes )
if ::lLoad
cFarProc := GetProcAddress( ::hDLL, "TWAIN_AcquireNative",.T., WORD,WORD,_INT )
::hDib := CallDLL( cFarProc,::hWnd,nPixType )
if ::hDib == 0
MsgInfo("Cannot Load Image, Scanner not found","")
else
::DibToFile(::hDib,cFile)
::Free( ::hDib )
end
end
RETU Self
METHOD DigiToClip()
// Acquire document & copy to ClipBoard
LOCAL nPixType := 0
LOCAL cFarProc
LOCAL nResult
if ::lLoad
cFarProc := GetProcAddress( ::hDLL, "TWAIN_AcquireToClipBoard",.T., _INT,WORD,_INT )
nResult := CallDLL( cFarProc,::hWnd,nPixType )
end
RETU Self
METHOD SetResolution( nDpi )
// NEW
LOCAL cFarProc
LOCAL uResult
DEFAULT nDpi := 100
if ::lLoad
cFarProc := GetProcAddress( ::hDLL, "TWAIN_SetResolution",.T., VOID,_DOUBLE )
uResult := CallDLL( cFarProc,nDpi )
end
RETU Self
METHOD Set(lShow)
// Show-Hide Scanner's Dialog Box
LOCAL nHide := 0 // Default: Shows Scanner's Dialog Box
LOCAL cFarProc
LOCAL uResult
DEFAULT lShow := .T.
if ::lLoad
nHide := iif(lShow,0,1)
cFarProc := GetProcAddress( ::hDLL, "TWAIN_SetHideUI",.T., VOID,_INT )
uResult := CallDLL( cFarProc,nHide )
end
RETU Self
METHOD Choose()
// Select Image Device Source
LOCAL cFarProc
LOCAL nResult
if ::lLoad
cFarProc := GetProcAddress( ::hDLL, "TWAIN_SelectImageSource",.T., _INT,WORD )
nResult := CallDLL( cFarProc,::hWnd )
end
RETU Self
//---------- Protected Methods
METHOD Free(hDib)
// Release Dib's Handle
LOCAL cFarProc
LOCAL uResult
cFarProc := GetProcAddress( ::hDLL, "TWAIN_FreeNative",.T., VOID,WORD )
uResult := CallDLL( cFarProc,hDib )
RETU NIL
METHOD DibToFile(hDib,cFile)
// Write to File From DIB's handle
LOCAL cFarProc
LOCAL nResult
LOCAL lRet
cFarProc := GetProcAddress( ::hDLL, "TWAIN_WriteNativeToFilename",.T., _INT,WORD,LPSTR)
lRet := ( (nResult:=CallDLL( cFarProc,hDib,cFile ))==0 )
DO CASE
CASE nResult == -1
MsgInfo("Annullato dall'utente","File non registrato")
CASE nResult == -2
MsgInfo("Errore durante la scrittura sul file "+cFile,"File non registrato")
CASE nResult == -3
MsgInfo("Errore interno sul file DIB","File non registrato")
CASE nResult == -4
MsgInfo("Errore durante la scrittura sul file "+cFile+", probabile spazio insufficiente sul disco !","File non registrato")
ENDCASE
RETU lRet
METHOD IsActive()
// Is Twain driver loaded ?
LOCAL cFarProc
LOCAL nResult
cFarProc := GetProcAddress( ::hDLL, "TWAIN_IsAvailable",.T., _INT )
if ! (nResult := CallDLL( cFarProc )) == 1
MsgAlert("Nessun driver per apparecchi TWAIN compatibili risulta disponibile !","Errore hardware")
// Messaggio inviato direttamente da TWAIN.DLL
end
RETU iif(nResult==1,.T.,.F.)
METHOD Register()
// Register my application into Twain application
LOCAL nMaiorNum := 1
LOCAL nMinorNum := 0 // Result -> 1.0
LOCAL nLanguage := 0
LOCAL nCountry := 0
LOCAL cVersion := "1.0"
LOCAL cManifact := "The Genius"
LOCAL cFamily := "Digitizer"
LOCAL cProduct := StrTran(cFileName(GetModuleFileName(GetInstance())),".EXE","")
LOCAL cFarProc
LOCAL uResult
cFarProc := GetProcAddress( ::hDLL, "TWAIN_RegisterApp",.T.,;
VOID,_INT,_INT,_INT,_INT,LPSTR,LPSTR,LPSTR,LPSTR )
uResult := CallDLL( cFarProc,nMaiorNum,nMinorNum,nLanguage,nCountry,cVersion,cManifact,cFamily,cProduct )
RETU NIL
//---------- END Protected Methods
STATIC FUNCTION BuildError(nError)
LOCAL cRet := "Errore nella libreria dinamica"
DO CASE
CASE nError == 0
cRet := "Memoria insufficiente ad eseguire il programma"
CASE nError == 2
cRet := "File non trovato"
CASE nError == 3
cRet := "Percorso non trovato"
CASE nError == 5
cRet := "Tentantivo di collegarsi dinamicamente ad un task o errore di condivisione"
CASE nError == 6
cRet := "La libreria richiede un segemento separato per ogni task"
CASE nError == 8
cRet := "Memoria insufficiente ad avviare l'applicazione"
CASE nError == 10
cRet := "Versione di MS Windows non corretta"
CASE nError == 11
cRet := "Libreria non valida oppure non un'applicazione MS Windows"
CASE nError == 12
cRet := "Applicazione disegnata per un sistema operativo diverso"
CASE nError == 13
cRet := "Applicazione disegnata per MS-DOS 4.0"
CASE nError == 14
cRet := "Tipo di file eseguibile sconosciuto"
CASE nError == 15
cRet := "Tentativo di caricare un'applicazione disegnata per funzionare in modalit… reale"
CASE nError == 16
cRet := "Tentativo di caricare una seconda istanza dell'applicazione contenente segmenti di dati multipli non marcati per la sola lettura"
ENDCASE
RETU OemToAnsi( cRet + "!" )
//------------------ Freeimage.dll ------------------------//
FUNCTION SaveImage( cFile )
LOCAL nFormat, hDib, hInfoH, hInfo, hBits, hWnd, hDC, hBmp, lOk
#ifdef __CLIPPER__
hLib = LOADLIB32( "freeimage.dll" )
#else
hLib = LOADLIBRARY( "freeimage.dll" )
#endif
if hLib <= 32
MsgStop( "Cannot load FreeImage.dll" )
return 0
endif
nFormat := FIGETFILETYPE( cFile, 0 )
hDib := FILOAD( nFormat, cFile, 0 )
hInfoH := FIGETINFOHEADER( hDib )
hInfo := FIGETINFO( hDib )
hBits := FIGETBITS( hDib )
hWnd := GETDESKTOPWINDOW()
#ifdef __CLIPPER__
hDC = GETDC32( hWnd )
#else
hDC = GETDC( hWnd )
#endif
lOk := fiSave( 2 , hDib, cFile )
hBmp = CREATEDIBITMAP( hDC, hInfoH, CBM_INIT, hBits, hInfo, DIB_RGB_COLORS )
#ifdef __CLIPPER__
RELEASEDC32( hWnd, hDC )
#else
RELEASEDC( hWnd, hDC )
#endif
FIUNLOAD( hDib )
#ifdef __CLIPPER__
FREELIB32( hLib )
#else
FREELIBRARY( hLib )
#endif
RETURN hBmp
DLL32 STATIC FUNCTION FIGETFILETYPE( cFileName AS LPSTR, nSize AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetFileType@8" LIB hLib
DLL32 STATIC FUNCTION FILOAD( nFormat AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_Load@12" LIB hLib
DLL32 STATIC FUNCTION FIUNLOAD( hDib AS LONG ) AS VOID;
PASCAL FROM "_FreeImage_Unload@4" LIB hLib
DLL32 STATIC FUNCTION FIGETINFOHEADER( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfoHeader@4" LIB hLib
DLL32 STATIC FUNCTION FIGETINFO( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetInfo@4" LIB hLib
DLL32 STATIC FUNCTION FIGETBITS( hDib AS LONG ) AS LONG;
PASCAL FROM "_FreeImage_GetBits@4" LIB hLib
DLL32 STATIC FUNCTION FISAVE( nFormat AS LONG, hDib AS LONG, cFileName AS LPSTR, nFlags AS LONG ) AS BOOL;
PASCAL FROM "_FreeImage_Save@16" LIB hLib
DLL32 STATIC FUNCTION FIROTATE( hDib AS LONG, nAngle AS _DOUBLE ) AS LONG;
PASCAL FROM "_FreeImage_RotateClassic@12" LIB hLib
DLL32 STATIC FUNCTION GETDC32( hWnd AS LONG ) AS LONG;
PASCAL FROM "GetDC" LIB "user32.dll"
DLL32 STATIC FUNCTION RELEASEDC32( hWnd AS LONG ) AS LONG;
PASCAL FROM "ReleaseDC" LIB "user32.dll"
DLL32 STATIC FUNCTION CREATEDIBITMAP( hDC AS LONG, hInfoH AS LONG, nFlags AS LONG, hBits AS LONG, hInfo AS LONG, nUsage AS LONG ) AS LONG;
PASCAL FROM "CreateDIBitmap" LIB "gdi32.dll"
DLL32 FUNCTION WOWHANDLE16( nHandle AS LONG, nHandleType AS LONG ) AS LONG;
PASCAL FROM "WOWHandle16" LIB "wow32.dll"
Regards,
Dutch
