Dear all,
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?
Regards,
Dutch
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?
/*------------------------------------------------------------------------*
ฺฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฤฟ
ณ ณ
ณ 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
Regards,
Dutch
FWH 2304 / xHarbour Simplex 1.2.3 / BCC73 / Pelles C / UEStudio
FWPPC 10.02 / Harbour for PPC (FTDN)
ADS V.9 / MySql / MariaDB
R&R 12 Infinity / Crystal Report XI R2
(Thailand)
Dutch
FWH 2304 / xHarbour Simplex 1.2.3 / BCC73 / Pelles C / UEStudio
FWPPC 10.02 / Harbour for PPC (FTDN)
ADS V.9 / MySql / MariaDB
R&R 12 Infinity / Crystal Report XI R2
(Thailand)