exif.cls

vb做的看图系统

    Const id = 306      'PropertyTagDateTime = &H132 = 306
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(DateToISODateTime(inVal), id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        'should be a date value
        'convert it to
        SetPropertyItem pi
    End If
    Set pi = Nothing
End Property


'Public Const PropertyTagExifExposureTime = &H829A
'Public Const PropertyTagExifFNumber = &H829D
Public Property Get ExifExposureTime() As String
    Const id = 33434 '&H829D       'PropertyTagSoftwareUsed= &h131 =
    Dim j As Long
    Dim sItem As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
        
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         Next j
        'retreival was successful
      ExifExposureTime = sItem 'Mid(sItem, 1, 1) & "." & Mid(sItem, 2)  '''test only for f1 to f9  not f11 and above
    End If
    Set pi = Nothing
End Property
Public Property Let ExifExposureTime(inVal As String)
    Const id = 33434    'PropertyTagCopyright = &H8298 = 33432
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(inVal, id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        SetPropertyItem pi
        'change updated value
        'EXIFsoftware = inVal
    End If
    Set pi = Nothing
End Property

Public Property Get ExifShutterSpeed() As String
    Const id = 37377 '&H829D       'PropertyTagSoftwareUsed= &h131 =
    Dim j As Long
    Dim sItem As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         '  Debug.Print "exp", j, pi.ParseString, pi.ParseLong(j)
         Next j
        'retreival was successful
      ExifShutterSpeed = "1/" & sItem & " s" 'Mid(sItem, 1, 1) & "." & Mid(sItem, 2)  '''test only for f1 to f9  not f11 and above
    End If
    Set pi = Nothing
End Property
Public Property Let ExifShutterSpeed(inVal As String)
    Const id = 37377    'PropertyTagCopyright = &H8298 = 33432
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(inVal, id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        SetPropertyItem pi
        'change updated value
        'EXIFsoftware = inVal
    End If
    Set pi = Nothing
End Property
'ExifExposureProg = &H8822
Public Property Get ExifExposureProg() As String
    Const id = 34850 '&H829D       'PropertyTagSoftwareUsed= &h131 =
    Dim j As Long
    Dim sItem As String
    Dim sDescription As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
       For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         Next j
         Select Case sItem
         Case 0
            sDescription = "Normal Mode"
         Case 1
            sDescription = "Manual Mode"
        Case 2
            sDescription = "Auto Mode"
         Case Else
            sDescription = sItem
         End Select
      ExifExposureProg = sDescription 'Mid(sItem, 1, 1) & "." & Mid(sItem, 2)  '''test only for f1 to f9  not f11 and above
    End If
    Set pi = Nothing
End Property
Public Property Let ExifExposureProg(inVal As String)
    Const id = 34850  'PropertyTagCopyright = &H8298 = 33432
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(inVal, id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        SetPropertyItem pi
        'change updated value
        'EXIFsoftware = inVal
    End If
    Set pi = Nothing
End Property
Public Property Get EXIFFNumber() As String
    Const id = 33437 '&H829D       'PropertyTagSoftwareUsed= &h131 =
    Dim j As Long
    Dim sItem As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
           ' Debug.Print "exif", j, pi.ParseString, pi.ItemType
         Next j
        'retreival was successful
       EXIFFNumber = Mid(sItem, 1, 1) & "." & Mid(sItem, 2)  '''test only for f1 to f9  not f11 and above
    End If
    Set pi = Nothing
End Property
Public Property Let EXIFFNumber(inVal As String)
    Const id = 33437    'PropertyTagCopyright = &H8298 = 33432
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(inVal, id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        SetPropertyItem pi
        'change updated value
        'EXIFsoftware = inVal
    End If
    Set pi = Nothing
End Property


Public Property Get EXIFsoftware() As String
    Const id = 305        'PropertyTagSoftwareUsed= &h131 =
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
        EXIFsoftware = pi.ParseString
    End If
    Set pi = Nothing
End Property
Public Property Let EXIFsoftware(inVal As String)
    Const id = 305      'PropertyTagCopyright = &H8298 = 33432
    Dim pi As New GDIPPropertyItem
    'create a properly formatted PropertyItem for adding
    If pi.SetPropertyStringValue(inVal, id) Then
        'use GDI+ to add it to the image (in memory - still will need physical save to disk)
        SetPropertyItem pi
        'change updated value
        'EXIFsoftware = inVal
    End If
    Set pi = Nothing
End Property
'read only from here down - these shouldnt need changing
'Public Const PropertyTagResolutionXUnit = &H5001
'Public Const PropertyTagResolutionYUnit = &H5002
'Public Const PropertyTagExifExposureProg = &H8822
'Public Const PropertyTagExifShutterSpeed = &H9201
'Public Const PropertyTagExifAperture = &H9202
'Public Const PropertyTagExifBrightness = &H9203
'Public Const PropertyTagExifExposureBias = &H9204
'Public Const PropertyTagExifMaxAperture = &H9205
'Public Const PropertyTagExifExposureProg = &H8822
Public Property Get EXIFmake() As String
    Const id = 271      'PropertyTagEquipMake = &H10F = 271
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
        EXIFmake = pi.ParseString
    End If
    Set pi = Nothing
End Property
Public Property Get EXIFmodel() As String
    Const id = 272      'PropertyTagEquipModel = &H110 = 272
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
        EXIFmodel = pi.ParseString
    End If
    Set pi = Nothing
End Property
Public Property Get EXIFtaken() As String
    Const id = 36867      'PropertyTagExifDTOrig = &H9003 = 36867
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
        EXIFtaken = ISODateTimeToDate(pi.ParseString)
    End If
    Set pi = Nothing
End Property
Public Property Get EXIFflash() As String
    Const id = 37385      'PropertyTagExifFlash = &H9209 = 37385
    Dim j As Long
    Dim sItem As String
    Dim sDescription As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         Next j
         Select Case sItem
         Case 0
            sDescription = "Not Fired"
         Case 1
            sDescription = "Fired."
         Case 5
            sDescription = "Strobe return not detected"
         Case 7
            sDescription = "Strobe return detected"
         Case 9
            sDescription = "Flash fired; Compulsory flash mode"
         Case 13
            sDescription = "Flash fired; Compulsory flash mode; Return light not detected"
         Case 15
            sDescription = "Flash fired; Compulsory flash mode; Return light detected"
         Case 16
            sDescription = "Flash not fired; Compulsory flash mode"
         Case 24
            sDescription = "Flash not fired; Auto mode"
         Case 25
            sDescription = "Flash fired; Auto mode"
         Case 29
            sDescription = "Flash fired; Auto mode; Return light not detected"
         Case 31
            sDescription = "Flash fired; Auto mode; Return light detected"
         Case 32
            sDescription = "No flash function"
         Case 65
            sDescription = "Flash fired; Red-eye reduction mode"
         Case 69
            sDescription = "Flash fired; Red-eye reduction mode; Return light not detected"
         Case 71
            sDescription = "Flash fired; Red-eye reduction mode; Return light detected"
         Case 73
            sDescription = "Flash fired; Compulsory flash mode; Red-eye reduction mode"
         Case 77
            sDescription = "Flash fired; Compulsory flash mode; Red-eye reduction mode; Return light not detected"
         Case 79
            sDescription = "Flash fired; Compulsory flash mode; Red-eye reduction mode; Return light detected"
         Case 89
            sDescription = "Flash fired; Auto mode; Red-eye reduction mode"
         Case 93
            sDescription = "Flash fired; Auto mode; Red-eye reduction mode; Return light not detected"
         Case 95
            sDescription = "Flash fired; Auto mode; Red-eye reduction mode; Return light detected"
         Case Else
            sDescription = sItem
         End Select
     
         EXIFflash = sDescription
    End If
    Set pi = Nothing
End Property
Public Property Get EXIFiso() As String
    Const id = 34855      'PropertyTagExifISOSpeed  = &H8827 = 34855
    Dim j As Long
    Dim sItem As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         Next j
        'retreival was successful
       EXIFiso = sItem
    End If
    Set pi = Nothing
' iso-speed                 8827  ISO Speed
' Values: An integer in the range 0 to 65535
    
End Property

Public Property Get EXIFprogram() As String
    Const id = 34850      'PropertyTagExifExposureProg = &H8822 = 34850
    Dim j As Long
    Dim sItem As String
    Dim sDescription As String
    Dim pi As New GDIPPropertyItem
    'get the property from the image
    Set pi = PropertyItemForID(id)
    'is it a valid object ?
    If pi.id = id Then
        'retreival was successful
         For j = 1 To pi.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & pi.ParseShort(j)
         Next j
        'retreival was successful
         Select Case sItem
         Case 1
            sDescription = "Manual"
         Case 2
            sDescription = "Program Normal"
         Case 3
            sDescription = "Aperture Priority"
         Case 4
            sDescription = "Shutter Priority"
         Case 5
            sDescription = "Program Creative"
         Case 6
            sDescription = "Program Action"
         Case 7
            sDescription = "Portrait Mode"
         Case 8
            sDescription = "Landscape Mode"
         End Select

         EXIFprogram = sDescription
    End If
    Set pi = Nothing
    
End Property
Public Property Get EXIFscene() As String
    Const id = 41990      '&HA406
    Dim j As Long
    Dim sItem As String
    Dim sDescription As String
    Dim pi As New GDIPPropertyItem