TScanner problem (FW & Clipper5.2)?

TScanner problem (FW & Clipper5.2)?

Postby dutch » Sat Aug 02, 2008 5:31 pm

Dear All,

I've got the problem with scanner&camera. I've used DMTwain.DLL for many years but It doesn't work anymore. I don't know when and why. I change my notebook 2 times.

Thanks&Regards,
Dutch

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"

#define STAND_ALONE

#define __CLIPPER__

#define TWAIN_DLL               "DMTwain.dll"

#define CBM_INIT 4    // for freeimage.dll

#define DIB_RGB_COLORS 0 // for freeimage.dll

STATIC oWnd
STATIC hLib              // for freeimage.dll

* #ifdef STAND_ALONE

FUNCTION ScanMe(cFileRes)

   /*
        FUNCTION Main(cFileRes)
      cFileRes = "C:\PATH\FILENAME.BMP , 150"       
      .OR.
      cFileRes = "C:\PATH\FILENAME.BMP"       // Dpi Will be 100 (default value)
   */

   LOCAL cFile, nRes, n
        cFile := cFileRes
   if !cFileRes == NIL
      if ( n:=AT(",",cFileRes) ) > 0
         cFile := Alltrim(Substr(cFileRes,1,n-1))
         nRes  := Val(Alltrim(Substr(cFileRes,n+1)))
      end
   end

        nRes  := 300

        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 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"

User avatar
dutch
 
Posts: 1542
Joined: Fri Oct 07, 2005 5:56 pm
Location: Thailand

Return to FiveWin for CA-Clipper

Who is online

Users browsing this forum: No registered users and 14 guests