' Utilizzare periferiche di acquisizione da codice Visual Basic - Listato 2
'==========================================================================
'Un elenco dei possibili valori da utilizzare per determinare
'la qualità della nuova immagine.
Public Enum PixelTypes
BW = TWAIN_BW
GRAYSCALE = TWAIN_GRAY
RGB = TWAIN_RGB
TPALETTE = TWAIN_PALETTE
ANYTYPE = TWAIN_ANYTYPE
End Enum
'Seleziona la periferica da cui acquisire le immagini
'Possono essere scanner,schede TV,webcam..
'Richiama un'apposita finestra che elenca le periferiche
Public Function SelectTwainsource(ByVal handle As Long) As Long
SelectTwainsource = TWAIN_SelectImageSource(handle)
End Function
'Acquisisce l'immagine direttamente in un file col nome specificato
'Il file è salvato in formato bitmap.
'Questa funzione è preferibile quando è stata selezionata una periferica
'con la funzione sopra esposta.
Public Function AcquireToFileName(ByVal handle As Long, _
ByVal outputFileName As String) As Long
AcquireToFileName = TWAIN_AcquireToFilename(handle, outputFileName)
End Function
'Acquisisce l'immagine direttamente in un file col nome specificato
'utilizzando la periferica di default
'L'immagine è salvata direttamente in formato bitmap
Public Function AcquireNativeToFile(ByVal outputFileName As String, _
ByVal PixelType As PixelTypes) As Long
Dim lnImageHandle As Long
lnImageHandle = TWAIN_AcquireNative(0, PixelType)
Dim lnReply
lnReply = TWAIN_WriteNativeToFilename(lnImageHandle, outputFileName)
TWAIN_FreeNative (lnImageHandle)
AcquireNativeToFile = lnReply
End Function
'Acquisisce l'immagine direttamente in un file temporaneo
'utilizzando la periferica di default
'L'immagine è salvata direttamente in formato bitmap e
'la funzione restituisce il nome del file creato
Public Function AcquireNative(ByVal PixelType As PixelTypes) As String
Dim Filename As String
Dim X As Single
X = Rnd(0)
Filename = GetTempFileName 'Si veda più avanti la funzione che restituisce
'un nome univoco di file temporaneo
Dim lnImageHandle As Long
lnImageHandle = TWAIN_AcquireNative(0, PixelType)
Dim lnReply
lnReply = TWAIN_WriteNativeToFilename(lnImageHandle, Filename)
TWAIN_FreeNative (lnImageHandle)
If lnReply = 0 Then
AcquireNative = Filename
Else
AcquireNative = ""
End If
End Function
'Acquisisce l'immagine negli appunti
Public Function AcquireToClipboard(ByVal handle As Long, _
ByVal PixelType As PixelTypes) As Long
Dim nClip As Long
nClip = TWAIN_AcquireToClipboard(handle, PixelType)
AcquireToClipboard = nClip
End Function
'Questa funzione stabilisce se i servizi Twain sono disponibili
'Viene chiamata dal metodo pubblico IsAvailable.
Private Function Availability() As Boolean
If TWAIN_IsAvailable = 0 Then
Availability = False
Else
Availability = True
End If
End Function
'Espone all'esterno la disponibilità dei servizi Twain
Public Function IsAvailable() As Boolean
IsAvailable = Availability
End Function
'Imposta la luminosità desiderata per l'immagine acquisita
Public Function SetBrightness(ByVal value As Double) As Long
SetBrightness = TWAIN_SetBrightness(value)
End Function
'Imposta il contrasto desiderato per l'immagine acquisita
Public Function SetContrast(ByVal value As Double) As Long
SetContrast = TWAIN_SetContrast(value)
End Function
'Imposta la risoluzione desiderata per l'immagine acquisita
Public Function SetCurrentResolution(ByVal value As Double) As Long
SetCurrentResolution = TWAIN_SetCurrentResolution(value)
End Function
'Ottiene la risoluzione impostata per l'acquisizione di immagini
Public Function GetCurrentResolution() As Double
GetCurrentResolution = TWAIN_GetCurrentResolution
End Function
'Ottiene il tipo di pixel in uso
Public Function GetPixelType() As Long
GetPixelType = TWAIN_GetPixelType
End Function
'Imposta il tipo di pixel da usare
Public Function SetCurrentPixelType(ByVal value As Long) As Long
SetCurrentPixelType = TWAIN_SetCurrentPixelType(value)
End Function
'Ottiene la profondità attuale per le immagini
Public Function GetBitDepth() As Long
GetBitDepth = TWAIN_GetBitDepth
End Function
'Imposta la profondità attuale per le immagini
'E' possibile utilizzare uno dei valori elencati nell'enum PixelTypes
Public Function SetBitDepth(ByVal value As Long) As Long
SetBitDepth = TWAIN_SetBitDepth(value)
End Function
'Verifica l'esistenza del file EZTW32.DLL nella cartella di sistema
'Utilizza l'API GetSystemDirectory per ottenere la cartella di sistema
Public Function IsTwainInstalled() As Boolean
Dim SystemFolder As String
SystemFolder = Space(MAX_PATH)
GetSystemDirectory SystemFolder, MAX_PATH
IsTwainInstalled = (0 < Len(Trim$(Dir$(SystemFolder + "\system32\EZTW32.DLL"))))
End Function
'Restituisce la versione della libreria in uso
Public Function Version() As String
Version = Str(TWAIN_EasyVersion() / 100)
End Function
'Il seguente metodo utilizza le API dichiarate all'inizio per restituire un nome
'di file univoco da utilizzare quale file temporaneo
'Il codice è stato reperito su http://www.freevbcode.com/ShowCode.Asp?ID=450
Private Function GetTempFileName() As String
Dim sTmp As String
Dim sTmp2 As String
sTmp2 = GetTempPath
sTmp = Space(Len(sTmp2) + 256)
Call GetTempFileNameA(sTmp2, App.EXEName, UNIQUE_NAME, sTmp)
GetTempFileName = Left$(sTmp, InStr(sTmp, Chr$(0)) - 1)
End Function
'Restituisce la cartella dei files temporanei
'Crea una stringa vuota, le assegna il nome della cartella e
'verifica la necessità di aggiungere i backslash
Private Function GetTempPath() As String
Dim sTmp As String
Dim i As Integer
i = GetTempPathA(0, "")
sTmp = Space(i)
Call GetTempPathA(i, sTmp)
GetTempPath = AddBackslash(Left$(sTmp, i - 1))
End Function
'Se "s" è una stringa valida e il suo ultimo carattere non è un backslash,lo aggiunge
Private Function AddBackslash(s As String) As String
If Len(s) > 0 Then
If Right$(s, 1) <> "\" Then
AddBackslash = s + "\"
Else
AddBackslash = s
End If
Else
AddBackslash = "\"
End If
End Function
'==========================================================================