Author Topic: 處理圖像及呼叫Victor Library的程序函數庫  (Read 7607 times)

admin

  • Administrator
  • *****
  • Posts: 0
    • View Profile
處理圖像及呼叫Victor Library的程序函數庫
« on: October 18, 2010, 02:56:27 AM »
Code: [Select]
Attribute VB_Name = "modImage"
' Image descriptor
Type imgdes
   ibuff As Long
   stx As Long
   sty As Long
   endx As Long
   endy As Long
   buffwidth As Long
   palette As Long
   colors As Long
   imgtype As Long
   bmh As Long
   hBitmap As Long
End Type

Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

' Global variables for this example
Global vimage As imgdes
Global pageno As Integer

Type TW_STR32
    items(33) As Byte ' Actually creates a 34-byte array
End Type

' Capability get/set struct
' Data for Twain ONEVALUE-type container
Type TWAIN_ONEVALUE
   val As Integer          ' the value
End Type

' Data for Twain ENUM-type container
Type TWAIN_ENUMTYPE
   tarray(17) As Integer
   nelems As Integer       ' Number of valid elements in array()
   currentIndex As Integer ' Index to the value that is currently in effect
   defaultIndex As Integer ' Power-up value
End Type

' Data for Twain RANGE-type container
Type TWAIN_RANGE
   min As Integer          ' Starting value in the range
   max As Integer          ' Final value in the range
   stepSize As Integer     ' Increment from min to max
   currentVal As Integer   ' The value that is currently in effect
   defaultVal As Integer   ' Power-up value
End Type

' Capability get/set struct
Type TWAIN_CAP_DATA
   conType As Integer    '  Container type, TWON_ONEVALUE, TWON_ENUMERATION, or TWON_RANGE,
   oneValue As TWAIN_ONEVALUE   ' Data if using ONEVALUE-type container
   enumType As TWAIN_ENUMTYPE   ' Data if using ENUM-type container
   range As TWAIN_RANGE         ' Data if using RANGE-type container
End Type

' Container constants (4)
Global Const TWON_ARRAY = 3
Global Const TWON_ENUMERATION = 4
Global Const TWON_ONEVALUE = 5
Global Const TWON_RANGE = 6

' Pixel type constants (9)
Global Const TWPT_BW = 0
Global Const TWPT_GRAY = 1
Global Const TWPT_RGB = 2
Global Const TWPT_PALETTE = 3
Global Const TWPT_CMY = 4
Global Const TWPT_CMYK = 5
Global Const TWPT_YUV = 6
Global Const TWPT_YUVK = 7
Global Const TWPT_CIEXYZ = 8

' Units constants (6)
Global Const TWUN_INCHES = 0
Global Const TWUN_CENTIMETERS = 1
Global Const TWUN_PICAS = 2
Global Const TWUN_POINTS = 3
Global Const TWUN_TWIPS = 4
Global Const TWUN_PIXELS = 5

Global Const TWAIN_STOP_SCAN = -67

Declare Sub freeimage Lib "VIC32.DLL" (image As imgdes)
Declare Sub copyimgdes Lib "VIC32.DLL" (srcimg As imgdes, desimg As imgdes)
Declare Function savetif Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal cmp As Long) As Long
Declare Function savejpg Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal quality As Long) As Long
Declare Function savetifpage Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal cmp As Long, ByVal page As Long) As Long

Declare Function TWdetecttwain Lib "VICTW32.DLL" (ByVal hWnd As Long) As Long
Declare Function TWgeterror Lib "VICTW32.DLL" () As Long
Declare Function TWgetmeasureunit Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef typeUnit As TWAIN_CAP_DATA) As Long
Declare Function TWgetpixeltype Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef pixelType As TWAIN_CAP_DATA) As Long
Declare Function TWgetbrightness Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef brightness As TWAIN_CAP_DATA) As Long
Declare Function TWgetcontrast Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef contrast As TWAIN_CAP_DATA) As Long
Declare Function TWgetsourcenames Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef namelist As TW_STR32, ByRef nameCount As Long) As Long
Declare Function TWgetsourcencount Lib "VICTW32.DLL" Alias "TWgetsourcenames" (ByVal hWnd As Long, ByVal nullval As Long, ByRef nameCount As Long) As Long
Declare Function TWgetxresolution Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef xres As TWAIN_CAP_DATA) As Long
Declare Function TWgetyresolution Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef yres As TWAIN_CAP_DATA) As Long
Declare Function TWscanimage Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef desimg As imgdes) As Long
Declare Function TWscanimageex Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef desimg As imgdes, pRect As RECT, ByVal showIU As Long) As Long
Declare Function TWscanmultipleimages Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef desimg As imgdes, ByVal saveScan As Long) As Long
Declare Function TWscanmultipleimagesex Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef desimg As imgdes, ByRef pRect As RECT, ByVal showIU As Long, ByVal saveScan As Long) As Long
Declare Function TWselectsource Lib "VICTW32.DLL" (ByVal hWnd As Long) As Long
Declare Function TWselectsourcebyname Lib "VICTW32.DLL" (ByVal hWnd As Long, ByVal dsname As String) As Long
Declare Function TWsetbrightness Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef brightness As TWAIN_CAP_DATA) As Long
Declare Function TWsetcontrast Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef contrast As TWAIN_CAP_DATA) As Long
Declare Function TWsetmeasureunit Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef typeUnit As TWAIN_CAP_DATA) As Long
Declare Function TWsetpixeltype Lib "VICTW32.DLL" (ByVal hWnd As Long, ByRef pixelType As TWAIN_CAP_DATA) As Long
Declare Function TWsetxresolution Lib "VICTW32.DLL" (ByVal hWnd As Long, xres As TWAIN_CAP_DATA) As Long
Declare Function TWsetyresolution Lib "VICTW32.DLL" (ByVal hWnd As Long, yres As TWAIN_CAP_DATA) As Long
Declare Sub TWsetproductname Lib "VICTW32.DLL" (ByVal prodName As String)
Declare Function TWvicversion Lib "VICTW32.DLL" () As Integer

Function DoScans(hWnd As Long, GSImage As imgdes, ScanLeft As Long, ScanTop As Long, ScanRight As Long, ScanBottom As Long, FilePath As String, Filename As String) As Long

Dim Srect As RECT
Dim ShowUI As Long
Dim RCode As Long
Dim Unit_Data As TWAIN_CAP_DATA
Dim Reso_Data As TWAIN_CAP_DATA
Dim Pixel_Data As TWAIN_CAP_DATA
Dim Bright_Data As TWAIN_CAP_DATA

    Unit_Data.oneValue.val = TWUN_INCHES
    Unit_Data.conType = TWON_ONEVALUE
   
    Reso_Data.oneValue.val = 72  '  dpi
    Reso_Data.conType = TWON_ONEVALUE
   
    Pixel_Data.oneValue.val = TWPT_GRAY  'Grayscale
    Pixel_Data.oneValue.val = TWPT_BW  '1-bit b/w
    Pixel_Data.conType = TWON_ONEVALUE
   
    Bright_Data.oneValue.val = 0  ' Range is usually -1000 to 1000
    Bright_Data.conType = TWON_ONEVALUE
   
    RCode = TWsetmeasureunit(hWnd, Unit_Data)   ' To set the device units
    RCode = TWsetyresolution(hWnd, Reso_Data)    ' To set the device resolution
    RCode = TWsetbrightness(hWnd, Bright_Data)  ' To set brightness
    RCode = TWsetcontrast(hWnd, Bright_Data)  ' To set contrast
   
    Srect.left = ScanLeft
    Srect.top = ScanTop
    Srect.right = ScanRight
    Srect.bottom = ScanBottom
   
    ShowUI = 0      ' Don't show User Interface
    pageno = 0
   
    DoScans = TWscanimageex(hWnd, GSImage, Srect, ShowUI)
    RCode = savejpg(FilePath & "\" & Filename & ".jpg", GSImage, 75)
    freeimage GSImage

End Function

Sub ScanImage(ControlImage As Object, ScanLeft As Long, ScanTop As Long, ScanRight As Long, ScanBottom As Long, FilePath As String, Filename As String)

Dim RCode As Long
Dim GSImage As imgdes

On Error GoTo ErrLoadCasino

    Screen.MousePointer = vbHourglass
   
        TWsetproductname ("Pass Technology") ' Store App name to display in Source dialog box. String may contain up to 32 chars.
        RCode = DoScans(0, GSImage, ScanLeft, ScanTop, ScanRight, ScanBottom, FilePath, Filename) ' This function has to reside in a .BAS module
        ControlImage.Picture = LoadPicture(FilePath & "\" & Filename & ".jpg")
       
    Screen.MousePointer = vbDefault

Exit Sub

ErrLoadCasino:

    MsgBox ("Scan Error"), 48

End Sub

Sub AdjustImagePos(ControlImage As Object, ContainerImage As Object)

    If ControlImage.Width > ContainerImage.Width Then
        ControlImage.left = 0
    Else
        ControlImage.left = (ContainerImage.Width - ControlImage.Width) / 2
    End If
   
    If ControlImage.Height > ContainerImage.Height Then
        ControlImage.top = 0
    Else
        ControlImage.top = (ContainerImage.Height - ControlImage.Height) / 2
    End If

End Sub