ca200sample.bas

1. Chromaticity Measurement Software (Ca200Sample_Color.exe) provides (电视色彩分析CA-210专用) Measuremen

Attribute VB_Name = "Ca200Sample"
Option Explicit

'===================================
' Application Data Type Definiition
'===================================
Public Type TypeColor
    color0 As Single
    color1 As Single
    color2 As Single
End Type

Public Type TypeMeasurementData

    dateColorData As Date
    timeColorData As Date
    lColorStatus As Long
    ssx As Single
    ssy As Single
    sLv As Single
    sLvfL As Single
    Sx As Single
    Sy As Single
    Sz As Single
    sud As Single
    svd As Single
    sduv As Single
    LT As Long
    
    susUser As Single
    svsUser As Single
    sLsUser As Single
    sdEUser As Single
    
    dateFMAData As Date
    timeFMAData As Date
    lFMAStatus As Long
    sFMA As Single
    
    dateJEITAData As Date
    timeJEITAData As Date
    lJEITAStatus As Long
    sJEITA As Single

End Type

Public Type TypeReferenceData
    sRefx As Single
    sRefy As Single
    sRefLv As Single
End Type

'===================================
' SDK Object
'===================================
Public objCa200 As Ca200
Public objCa As Ca
Public objProbe As Probe
Public objMemory As Memory

'===================================
' SDK Constant
'===================================
'---------------
' CA Display Mode
'---------------
Public Const DSP_LXY As Long = 0
Public Const DSP_DUV As Long = 1
Public Const DSP_ANL As Long = 2
Public Const DSP_ANLG As Long = 3
Public Const DSP_ANLR As Long = 4
Public Const DSP_PUV As Long = 5
Public Const DSP_FMA As Long = 6
Public Const DSP_XYZ As Long = 7
Public Const DSP_JEITA As Long = 8

'---------------
' CA Sync. Mode
'---------------
Public Const SYNC_NTSC As Long = 0
Public Const SYNC_PAL As Long = 1
Public Const SYNC_EXT As Long = 2
Public Const SYNC_UNIV As Long = 3
Public Const SYNC_INT As Long = 4

'---------------
' CA Display Digits Mode
'---------------
Public Const DIGT_3 As Long = 0
Public Const DIGT_4 As Long = 1

'---------------
' CA Fas/Slow Mode
'---------------
Public Const AVRG_SLOW As Long = 0
Public Const AVRG_FAST As Long = 1
Public Const AVRG_AUTO As Long = 2

'---------------
' CA Brightness Unit Option
'---------------
Public Const BUNIT_FL As Long = 0
Public Const BUNIT_CD As Long = 1

'---------------
' CA Calibration Mode
'---------------
' 021225
Public Const CAL_A As Long = 0

Public Const CAL_D65 As Long = 1
Public Const CAL_9300 As Long = 2
Public Const CAL_CA100 As Long = 3
Public Const CAL_WHITE As Long = 10
Public Const CAL_MATRIX As Long = 11
Public Const CAL_WHITE_NEW As Long = 20
Public Const CAL_MATRIX_NEW As Long = 21

' 021225
Public Const CAL_WHITE_I As Long = 30
Public Const CAL_MATRIX_I As Long = 31

' 030402
Public Const CAL_WHITE_U As Long = 50
Public Const CAL_MATRIX_U As Long = 51

' 030402
Public Const CAL_WHITE_SU As Long = 60
Public Const CAL_MATRIX_SU As Long = 61

'===================================
' Application Data
'===================================
Public typCurrentMeasurementData As TypeMeasurementData
Public typCurrentRefereceData As TypeReferenceData
Public gstrCADataFile As String
Public gstrVGDataFile As String

Public HasMsrData As Boolean

'===================================
' Application Constant
'===================================
'021225
Public Const STD_A As String = "Minolta A"

Public Const STD_D65 As String = "Minolta 65K"
Public Const STD_9300K As String = "Minolta 93K"
Public Const STD_CA100 As String = "Minolta CA100"
Public Const STD_WHITE As String = "User White"
Public Const STD_MATRIX As String = "User Matrix"

Public CA_Type As String
Public gstrLvOrEv As String




Public Sub Main()
    Dim i As Integer
    
    '===================================
    ' Set Error Trap
    '===================================
    On Error GoTo E
    
    '===================================
    ' Create SDK/Application Object
    '===================================
    Set objCa200 = New Ca200
    
    '===================================
    ' Set Configuration
    '===================================
    objCa200.AutoConnect

    '===================================
    ' Initialize SDK Object
    '===================================
    Set objCa = objCa200.SingleCa
    Set objProbe = objCa.SingleProbe
    Set objMemory = objCa.Memory
    
    ' 021225
    CA_Type = objCa.CAType
    
    '===================================
    ' Initialize CA and Application
    '===================================
    gstrLvOrEv = "Lv"
    
    ' 0 Calibration
    MsgBox "0-Cal", vbOKOnly
    objCa.CalZero
    Screen.MousePointer = vbHourglass
    
    objMemory.GetReferenceColor objProbe.ID, typCurrentRefereceData.sRefx, typCurrentRefereceData.sRefy, typCurrentRefereceData.sRefLv
    
  '  Load FormCaCal
    FormCaCal.Show
    FormCaCal.Enabled = False
    
    ' 021225
    FormCaCal.LabelData(2).Caption = gstrLvOrEv + ":"
    FormCaCal.LabelData(5).Caption = gstrLvOrEv + ":"
    
    DoEvents
    Set FormCaCal.objCaControl.Ca = objCa
    Set FormCaCal.objCaControl.Probe = objProbe
    Set FormCaCal.objCaControl.Memory = objMemory
    FormCaCal.objCaControl.UpdateCaInfo
    FormCaCal.objCaControl.UpdateMemoryInfo
    
    '===================================
    ' Show Main Form
    '===================================
    'Load FormCaCal
    FormCaCal.Tag = "END"
    Screen.MousePointer = vbDefault
    FormCaCal.Enabled = True
    'FormCaCal.Show
    
    Exit Sub
    
E:
    '===================================
    ' Error Trap
    '===================================
    Dim strERR As String
    Dim iReturn As Integer
    
    strERR = "Error from " + Err.Source + Chr$(10) + Chr$(13)
    strERR = strERR + Err.Description + Chr$(10) + Chr$(13)
    strERR = strERR + "HRESULT " + CStr(Err.Number - vbObjectError)
    iReturn = MsgBox(strERR, vbRetryCancel)
    Select Case iReturn
        Case vbRetry: Resume
        Case Else:
            'objCa.RemoteMode = 0
            End
    End Select
End Sub