vbAccelerator - Contents of code file: frmImageTest.frm

VERSION 5.00
Begin VB.Form frmImageTester 
   Caption         =   "GdiPlus Image Save, Load and Draw Tester"
   ClientHeight    =   7455
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   10350
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmImageTest.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   7455
   ScaleWidth      =   10350
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdOptions 
      Caption         =   "&Options..."
      Height          =   495
      Left            =   2400
      TabIndex        =   3
      Top             =   60
      Width           =   1095
   End
   Begin VB.CommandButton cmdCodecs 
      Caption         =   "&Show Codecs..."
      Height          =   495
      Left            =   3540
      TabIndex        =   2
      Top             =   60
      Width           =   1095
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "&Save..."
      Enabled         =   0   'False
      Height          =   495
      Left            =   1260
      TabIndex        =   1
      Top             =   60
      Width           =   1095
   End
   Begin VB.CommandButton cmdOpen 
      Caption         =   "&Open..."
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   1095
   End
   Begin VB.Line linSep 
      BorderColor     =   &H80000000&
      X1              =   120
      X2              =   10260
      Y1              =   660
      Y2              =   660
   End
End
Attribute VB_Name = "frmImageTester"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_image As GDIPBitmap

Private Sub cmdCodecs_Click()
   Dim f As New frmCodecs
   f.Show vbModal, Me
End Sub

Private Sub cmdOpen_Click()
Dim sFIle As String
Dim sFilter As String
Dim g As New GCommonDialog
Dim i As Long

   For i = 1 To g_cDecoders.Count
      sFilter = sFilter & g_cDecoders.Item(i).FormatDescription & _
         "(" & g_cDecoders.Item(i).FilenameExtension & ")|" & _
         g_cDecoders.Item(i).FilenameExtension & "|"
   Next i
   sFilter = sFilter & "All Files (*.*)|*.*"

   If (g.VBGetOpenFileName(sFIle, _
      Filter:=sFilter, _
      Owner:=Me.hwnd)) Then
   
      cmdSave.Enabled = False
   
      Set m_image = New GDIPBitmap
   
      On Error GoTo errorHandler
      m_image.Image.FromFile sFIle
      
      Me.Refresh
      cmdSave.Enabled = True
      
   End If
   
   Exit Sub
   
errorHandler:
   MsgBox "Could not load file: " & Err.Description, vbInformation
   Set m_image = Nothing
   Me.Refresh
   Exit Sub
End Sub

Private Sub cmdOptions_Click()
   Dim f As New frmSaveOptionsDialog
   f.Show vbModal, Me
End Sub

Private Sub cmdSave_Click()
   If Not (m_image Is Nothing) Then
      
      Dim sFIle As String
      Dim sFilter As String
      Dim iFilterIndex As Long
      Dim g As New GCommonDialog
      Dim i As Long

      For i = 1 To g_cEncoders.Count
         sFilter = sFilter & g_cEncoders.Item(i).FormatDescription & _
            "(" & g_cEncoders.Item(i).FilenameExtension & ")|" & _
            g_cEncoders.Item(i).FilenameExtension & "|"
      Next i
      sFilter = sFilter & "All Files (*.*)|*.*"

      If (g.VBGetSaveFileName(sFIle, _
         Filter:=sFilter, _
         FilterIndex:=iFilterIndex, _
         Owner:=Me.hwnd)) Then
         
         ' evaluate which codec we're going to use:
         Dim cCodec As GDIPImageCodec
         Dim iEncoder As Long
         If (iFilterIndex <= g_cEncoders.Count) Then
            Set cCodec = g_cEncoders.Item(iFilterIndex)
         Else
            ' we've picked all files
            On Error Resume Next
            Dim sExt As String
            i = InStrRev(sFIle, ".")
            If (i > 0) Then
               sExt = Mid$(sFIle, i + 1)
               Set cCodec = g_cEncoders.EncoderForExtension(sExt)
            End If
            On Error GoTo 0
            If (cCodec Is Nothing) Then
               Set cCodec = g_cEncoders.Item(0)
            End If
         End If
         
         ' Check we have an extension:
         i = InStrRev(sFIle, ".")
         If (i < InStrRev(sFIle, "\")) Then
            ' we don't have an extension
            sExt = cCodec.FilenameExtension
            i = InStr(sExt, ";")
            If (i > 0) Then
               sExt = Left$(sExt, i - 1)
            End If
            sExt = Mid$(sExt, 2)
            sFIle = sFIle & sExt
         End If
         
         
         ' set parameters as required:
         Dim cParamList As GDIPEncoderParameterList
         Dim cParam As GDIPEncoderParameter
         If (cCodec.MimeType = "image/jpeg") Then
            Set cParamList =
             m_image.Image.EncoderParameterList(cCodec.CodecCLSID)
            Set cParam = cParamList.ParameterForGuid(EncoderQuality)
            cParam.valueCount = 1
            cParam.value(1) = g_cSaveOptions.JpgQuality
            
            Set cParam = cParamList.ParameterForGuid(EncoderTransformation)
            If Not (g_cSaveOptions.JpgTransformation = 0) Then
               cParam.valueCount = 1
               cParam.value(1) = g_cSaveOptions.JpgTransformation
            Else
               cParam.valueCount = 0
            End If

         ElseIf (cCodec.MimeType = "image/tiff") Then
            Set cParamList =
             m_image.Image.EncoderParameterList(cCodec.CodecCLSID)
            
            Set cParam = cParamList.ParameterForGuid(EncoderCompression)
            cParam.valueCount = 1
            cParam.value(1) = g_cSaveOptions.TiffCompression

            Set cParam = cParamList.ParameterForGuid(EncoderColorDepth)
            cParam.valueCount = 1
            cParam.value(1) = g_cSaveOptions.TiffBitDepth
            
         End If
      
         ' Finally, save the image:
         m_image.Image.Save sFIle, cCodec.CodecCLSID
      End If
      
   End If
End Sub

Private Sub Command3_Click()
   Dim b() As Byte
   Dim iFile As Integer
   Dim lSize As Long
   
   iFile = FreeFile
   Open "C:\Documents and Settings\Steve McMahon\My
    Documents\Websites\vbAccelerator.com\dev\Controls.png" For Binary As #iFile
   lSize = LOF(iFile)
   ReDim b(0 To lSize - 1)
   Get #iFile, , b
   Close #iFile
   
   Dim stream As New MemoryStream
   stream.Init VarPtr(b(0)), lSize
   
   Set m_image = New GDIPBitmap
   m_image.Image.FromStream stream
   
End Sub

Private Sub Form_Load()
   
   Me.Show
   Me.Refresh
   
   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
   Else
      Set g_cDecoders = New GDIPImageDecoderList
      Set g_cEncoders = New GDIPImageEncoderList
   End If
   
End Sub

Private Sub Form_Paint()
   If Not (m_image Is Nothing) Then
      Dim lLeft As Long
      Dim lTop As Long
      lLeft = linSep.X1 \ Screen.TwipsPerPixelX
      lTop = linSep.Y2 \ Screen.TwipsPerPixelY + 4
   
      Dim gfx As New GDIPGraphics
      gfx.FromHDC Me.hdc
   
      gfx.DrawImagePointLv m_image.Image, lLeft, lTop
   
      gfx.Dispose
   End If

End Sub

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