relctrl.bas

canon 相机SDK,非常难得

Attribute VB_Name = "Module5"
Option Explicit

'----------------------------------------------
' To execute this sample application
'----------------------------------------------
'1.Copy this folder and all contents to HD of PC.
'2.Open the Progress.vbp with Visual Basic.
'3.Click the menu [File]-[Make Progress.exe...] to make the progress.exe.
'4.Open the RelCtrl.vbp with Visual Basic.
'5.Click the menu [Project]-[References...], the the [References] dialog
'  box will appear.
'6.Check the "Progress" to set the reference to the progress.exe.
'7.Click the menu [File]-[Make RelCtrl.exe...] to compile the project.
'  Then, the RelCtrl.exe will be made.
'6.Copy all files included in the \CDSDK\Redist folder to the project folder.
'----------------------------------------------

Public Const DEVICE_NOT_CHOICE = &HFFFF

Public Const cdTRUE = 1
Public Const cdFALSE = 0

Public m_SourceInfo     As cdSourceInfo
Public m_CamEventID     As Long
Public m_RelEventID     As Long
Public m_RelDataPtr     As Long
Public m_VFDataPtr      As Long
Public m_BackSurface    As DIBData
Public m_Progress       As CProgress

'-----------------------------------------------------------------------------
'               For browser
'-----------------------------------------------------------------------------
Public Const MAX_PATH = 260

'// messages to browser
Public Const WM_USER = &H400
Public Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Public Const BFFM_ENABLEOK = (WM_USER + 101)
Public Const BFFM_SETSELECTIONA = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW = (WM_USER + 103)
Public Const BFFM_SETSTATUSTEXTW = (WM_USER + 104)

'// message from browser
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_VALIDATEFAILED = 3        '// lParam:szPath ret:1(cont),0(EndDialog)
Public Const BFFM_VALIDATEFAILEDW = 4       '// lParam:wzPath ret:1(cont),0(EndDialog)

'// Browsing for directory.
Public Const BIF_RETURNONLYFSDIRS = &H1      '// For finding a folder to start document searching
Public Const BIF_DONTGOBELOWDOMAIN = &H2     '// For starting the Find Computer
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_EDITBOX = &H10
Public Const BIF_VALIDATE = &H20             '// insist on valid result (or CANCEL)
Public Const BIF_BROWSEFORCOMPUTER = &H1000  '// Browsing for Computers.
Public Const BIF_BROWSEFORPRINTER = &H2000   '// Browsing for Printers
Public Const BIF_BROWSEINCLUDEFILES = &H4000 '// Browsing for Everything

Public Type BROWSEINFO
    hwndOwner       As Long
    pidlRoot        As Long
    pszDisplayName  As Long
    lpszTitle       As String
    ulFlags         As Long
    lpfn            As Long
    lParam          As Long
    iImage          As Long
End Type

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pIDL As Long, ByVal pszPath As String) As Long
Public Declare Function CoTaskMemFree Lib "OLE32.DLL" (pv As Long) As Long


'-----------------------------------------------------------------------------
'               For ViewFinder
'-----------------------------------------------------------------------------
Public Type DIBData
    hBmp    As Long
    vpBits  As Long
End Type

Type BITMAPINFOHEADER
    biSize          As Long
    biWidth         As Long
    biHeight        As Long
    biPlanes        As Integer
    biBitCount      As Integer
    biCompression   As Long
    biSizeImage     As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed       As Long
    biClrImportant  As Long
End Type

Type RGBQUAD
    rgbBlue       As Byte
    rgbGreen      As Byte
    rgbRed        As Byte
    rgbReserved   As Byte
End Type

Public Type BITMAPINFO
    bmiHeader       As BITMAPINFOHEADER
    bmiColors(255)  As RGBQUAD
End Type

Public Type BITMAPFILEHEADER
    bfType      As Integer
    bfSize      As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits   As Long
End Type

'/* constants for the biCompression field */
Public Const BI_RGB = 0
Public Const BI_RLE8 = 1
Public Const BI_RLE4 = 2

'/* DIB color table identifiers */
Public Const DIB_RGB_COLORS = 0     '/* color table in RGBs */
Public Const DIB_PAL_COLORS = 1     '/* color table in palette indices */

'/* Ternary raster operations */
Public Const SRCCOPY = &HCC0020             '/* dest = source                   */
Public Const SRCPAINT = &HEE0086            '/* dest = source OR dest           */
Public Const SRCAND = &H8800C6              '/* dest = source AND dest          */
Public Const SRCINVERT = &H660046           '/* dest = source XOR dest          */
Public Const SRCERASE = &H440328            '/* dest = source AND (NOT dest )   */
Public Const NOTSRCCOPY = &H330008          '/* dest = (NOT source)             */
Public Const NOTSRCERASE = &H1100A6         '/* dest = (NOT src) AND (NOT dest) */
Public Const MERGECOPY = &HC000CA           '/* dest = (source AND pattern)     */
Public Const MERGEPAINT = &HBB0226          '/* dest = (NOT source) OR dest     */
Public Const PATCOPY = &HF00021             '/* dest = pattern                  */
Public Const PATPAINT = &HFB0A09            '/* dest = DPSnoo                   */
Public Const PATINVERT = &H5A0049           '/* dest = pattern XOR dest         */
Public Const DSTINVERT = &H550009           '/* dest = (NOT dest)               */
Public Const BLACKNESS = &H42               '/* dest = BLACK                    */
Public Const WHITENESS = &HFF0062           '/* dest = WHITE                    */

'/* Image size of ViewFinder */
Public Const VIEWFINDER_WIDTH = 320
Public Const VIEWFINDER_HEIGHT = 240

Public Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, Src As Any, ByVal Num As Long)
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Public Function BrowseCallbackFunc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    
    Select Case uMsg
        Case BFFM_INITIALIZED
            Call SendMessage(hwnd, BFFM_SETSELECTIONA, cdTRUE, ByVal lpData)
        Case BFFM_SELCHANGED
        Case BFFM_VALIDATEFAILED
        Case BFFM_VALIDATEFAILEDW
    End Select
    
End Function

Public Function FuncPtr(ByVal ptr As Long) As Long
    FuncPtr = ptr
End Function

Public Function CamEventCallbackFunc(ByVal eventID As Long, ByVal pData As Long, ByVal DataSize As Long, ByVal Context As Long) As Long
    m_CamEventID = eventID
    CamEventCallbackFunc = cdOK
End Function

Public Function RelEventCallBackFunc(ByVal eventID As Long, ByVal pData As Long, ByVal DataSize As Long, ByVal Context As Long) As Long
    m_RelEventID = eventID
    m_RelDataPtr = pData
    RelEventCallBackFunc = cdOK
End Function

Public Function ViewFinderCallbackFunc(ByVal pBuf As Long, ByVal Size As Long, ByVal Format As Long, ByVal Context As Long) As Long
    m_VFDataPtr = pBuf
    ViewFinderCallbackFunc = cdOK
End Function

Public Function ProgressCallbackFunc(ByVal progress As Long, ByVal status As Long, ByVal Context As Long) As Long
    Call m_Progress.SetProgress(progress, status)
    ProgressCallbackFunc = cdOK
 End Function