vbAccelerator - Contents of code file: frmExifTags.frm

VERSION 5.00
Begin VB.Form frmExifTags 
   Caption         =   "GDI+ EXIF Tags Demonstration"
   ClientHeight    =   6825
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9540
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmExifTags.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6825
   ScaleWidth      =   9540
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdOpen 
      Caption         =   "&Open..."
      Height          =   375
      Left            =   8460
      TabIndex        =   2
      Top             =   60
      Width           =   1035
   End
   Begin VB.TextBox txtFilename 
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   60
      Width           =   7215
   End
   Begin VB.PictureBox picSplit 
      BorderStyle     =   0  'None
      Height          =   6195
      Left            =   60
      ScaleHeight     =   6195
      ScaleWidth      =   9435
      TabIndex        =   3
      Top             =   600
      Width           =   9435
      Begin VB.ListBox lstEXIFTags 
         Height          =   6105
         Left            =   7140
         TabIndex        =   5
         Top             =   0
         Width           =   2235
      End
      Begin VB.PictureBox picImage 
         Height          =   6075
         Left            =   0
         ScaleHeight     =   6015
         ScaleWidth      =   6975
         TabIndex        =   4
         Top             =   0
         Width           =   7035
      End
   End
   Begin VB.Line linSep 
      BorderColor     =   &H80000000&
      X1              =   60
      X2              =   10200
      Y1              =   540
      Y2              =   540
   End
   Begin VB.Label lblFilename 
      Caption         =   "&Filename:"
      Height          =   315
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmExifTags"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_img As GDIPImage
Private m_split As cSplitter

Private Sub showEXIFTags(img As GDIPImage)
   Dim i As Long
   Dim sItem As String
   Dim prop As GDIPPropertyItem
   Dim j As Long
   Dim v As Variant
   Dim s As String
   
   For i = 1 To img.PropertyCount
      Set prop = img.PropertyItem(i)
      sItem = prop.Name & " "
      
      Select Case prop.ItemType
      Case PropertyTagTypeASCII
         sItem = sItem & prop.ParseString()
         
      Case PropertyTagTypeRational, PropertyTagTypeSRational
         For j = 1 To prop.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            v = prop.ParseRational(j)
            sItem = sItem & v(1) & "/" & v(2)
         Next j
         
      Case PropertyTagTypeLong
         For j = 1 To prop.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & prop.ParseLong(j)
         Next j
      
      Case PropertyTagTypeShort
         For j = 1 To prop.ValueCount
            If (j > 1) Then
               sItem = sItem & ", "
            End If
            sItem = sItem & prop.ParseShort(j)
         Next j
      
      Case PropertyTagTypeUndefined
         ReDim b(0 To prop.ValueCount - 1) As Byte
         prop.GetData b
         For j = 1 To prop.ValueCount - 1
            If (j > 1) Then
               sItem = sItem & " "
            End If
            s = Hex(b(j - 1))
            If Len(s) = 1 Then s = "0" & s
            sItem = sItem & s
         Next j
      
      Case Else
         sItem = sItem & prop.ItemType & " " & prop.Length
      End Select
      lstEXIFTags.AddItem sItem
   Next i
End Sub


Private Sub loadImageAndShowTags(ByVal sFIle As String)
   picImage.Cls
   lstEXIFTags.Clear
         
   On Error GoTo errorHandler
   ' Load the image:
   Set m_img = New GDIPImage
   m_img.FromFile sFIle
   
   ' Read EXIFTags:
   showEXIFTags m_img
            
   picImage.Refresh
   Exit Sub
   
errorHandler:
   MsgBox "An error occurred trying to show the information for this file: " &
    Err.Description, vbInformation
   Set m_img = Nothing
   Exit Sub
   
End Sub

Private Sub cmdOpen_Click()
   
   Dim g As New GCommonDialog
   Dim sFIle As String
   If (g.VBGetOpenFileName(sFIle, _
      Filter:="JPEG Files (*.jpg)|*.JPG|All Files (*.*)|*.*", _
      DefaultExt:="JPG", _
      Owner:=Me.hWnd)) Then
      txtFilename.Text = sFIle
      loadImageAndShowTags sFIle
   End If
   
End Sub

Private Sub Form_Load()
   
   Set m_split = New cSplitter
   m_split.Orientation = cSPLTOrientationVertical
   m_split.FullDrag = False
   m_split.Bind picImage, lstEXIFTags
   
   If Not (GDIPlusCreate()) Then
      MsgBox "GDI+ Initialisation Failed.", vbExclamation
      Dim ctl As Control
      For Each ctl In Me.Controls
         On Error Resume Next
         ctl.Enabled = False
      Next
   End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   If Not m_img Is Nothing Then
      m_img.Dispose
      Set m_img = Nothing
   End If
   GDIPlusDispose
End Sub

Private Sub Form_Resize()
   On Error Resume Next
   linSep.X2 = Me.ScaleWidth - linSep.X1 * 2
   Dim lSize As Long
   lSize = Me.ScaleWidth - txtFilename.Left - cmdOpen.Width - 4 *
    Screen.TwipsPerPixelX
   txtFilename.Width = lSize
   cmdOpen.Left = txtFilename.Left + txtFilename.Width + 2 *
    Screen.TwipsPerPixelX
   picSplit.Move picSplit.Left, picSplit.Top, Me.ScaleWidth - picSplit.Left *
    2, Me.ScaleHeight - picSplit.Top - 4 * Screen.TwipsPerPixelY
End Sub

Private Sub picImage_Paint()
   
   If Not m_img Is Nothing Then
      ' Draw the image on the picturebox, stretched using high-quality
      ' bicubic scaling to fit:
      Dim gfx As New GDIPGraphics
      gfx.FromHDC picImage.hdc
      gfx.InterpolationMode = InterpolationModeBicubic
      
      Dim destRect As RECTL
      destRect.Width = picImage.ScaleWidth \ Screen.TwipsPerPixelX
      destRect.Height = picImage.ScaleHeight \ Screen.TwipsPerPixelY
      
      gfx.DrawImageStretchAttrL m_img, destRect, 0, 0, m_img.Width,
       m_img.Height, UnitPixel, 0, 0, 0
      gfx.Dispose
   End If
   
End Sub

Private Sub picSplit_MouseDown(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   m_split.MouseDown Button, Shift, x, y
End Sub

Private Sub picSplit_MouseMove(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   m_split.MouseMove Button, Shift, x, y
End Sub

Private Sub picSplit_MouseUp(Button As Integer, Shift As Integer, x As Single,
 y As Single)
   m_split.MouseUp Button, Shift, x, y
End Sub

Private Sub picSplit_Resize()
   m_split.Resize
End Sub