Attribute VB_Name = "GDIRender"

'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

Option Explicit

' ----==== GDIPlus Const ====----
Private Const GdiPlusVersion As Long = 1&

Private Const QualityModeInvalid As Long = -1&
Private Const QualityModeDefault As Long = 0&
Private Const QualityModeLow As Long = 1&
Private Const QualityModeHigh As Long = 2&

' ----==== GDIPlus Types ====----
Private Type GDIPlusStartupInput
    GdiPlusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

' ----==== GDIPlus Enums ====----
Public Enum Status 'GDI+ Status
    OK = 0
    GenericError = 1
    InvalidParameter = 2
    OutOfMemory = 3
    ObjectBusy = 4
    InsufficientBuffer = 5
    NotImplemented = 6
    Win32Error = 7
    WrongState = 8
    Aborted = 9
    FileNotFound = 10
    ValueOverflow = 11
    AccessDenied = 12
    UnknownImageFormat = 13
    FontFamilyNotFound = 14
    FontStyleNotFound = 15
    NotTrueTypeFont = 16
    UnsupportedGdiplusVersion = 17
    GdiplusNotInitialized = 18
    PropertyNotFound = 19
    PropertyNotSupported = 20
    ProfileNotFound = 21
End Enum

Public Enum InterpolationMode
    InterpolationModeInvalid = QualityModeInvalid
    InterpolationModeDefault = QualityModeDefault
    InterpolationModeLowQuality = QualityModeLow
    InterpolationModeHighQuality = QualityModeHigh
    InterpolationModeBilinear = QualityModeHigh + 1
    InterpolationModeBicubic = QualityModeHigh + 2
    InterpolationModeNearestNeighbor = QualityModeHigh + 3
    InterpolationModeHighQualityBilinear = QualityModeHigh + 4
    InterpolationModeHighQualityBicubic = QualityModeHigh + 5
End Enum

Public Enum SmoothingMode
    SmoothingModeInvalid = QualityModeInvalid
    SmoothingModeDefault = QualityModeDefault
    SmoothingModeHighSpeed = QualityModeLow
    SmoothingModeHighQuality = QualityModeHigh
    SmoothingModeNone = QualityModeHigh + 1
    SmoothingModeAntiAlias8x4 = QualityModeHigh + 2
    SmoothingModeAntiAlias = SmoothingModeAntiAlias8x4
    'SmoothingModeAntiAlias8x8
End Enum

Public Enum PixelOffsetMode
    PixelOffsetModeInvalid = QualityModeInvalid
    PixelOffsetModeDefault = QualityModeDefault
    PixelOffsetModeHighSpeed = QualityModeLow
    PixelOffsetModeHighQuality = QualityModeHigh
    PixelOffsetModeNone = QualityModeHigh + 1
    PixelOffsetModeHalf = QualityModeHigh + 2
End Enum

Public Enum CompositingQualityMode
    CompositingQualityInvalid = QualityModeInvalid
    CompositingQualityDefault = QualityModeDefault
    CompositingQualityHighSpeed = QualityModeLow
    CompositingQualityHighQuality = QualityModeHigh
    CompositingQualityGammaCorrected = QualityModeHigh + 1
    CompositingQualityAssumeLinear = QualityModeHigh + 2
End Enum

Public Enum CompositingModeMode
    CompositingModeSourceOver = 0
    CompositingModeSourceCopy = 1
End Enum

' ----==== GDI+ API Declarationen ====----
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GDIPlusStartupInput, Optional ByRef lpOutput As Any) As Status
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Status
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, ByRef image As Long) As Status
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, ByRef graphics As Long) As Status
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Status
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal image As Long, ByVal X As Single, ByVal Y As Single, ByVal Width As Single, ByVal Height As Single) As Status
Private Declare Function GdipGetImageDimension Lib "gdiplus" (ByVal image As Long, ByRef Width As Single, ByRef Height As Single) As Status
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Status
Private Declare Function GdipSetInterpolationMode Lib "gdiplus" (ByVal graphics As Long, ByVal InterpolationMode As InterpolationMode) As Status
Private Declare Function GdipGetInterpolationMode Lib "gdiplus" (ByVal graphics As Long, ByRef InterpolationMode As InterpolationMode) As Status
Private Declare Function GdipSetSmoothingMode Lib "gdiplus" (ByVal graphics As Long, ByVal SmoothingMode As SmoothingMode) As Status
Private Declare Function GdipGetSmoothingMode Lib "gdiplus" (ByVal graphics As Long, ByRef SmoothingMode As SmoothingMode) As Status
Private Declare Function GdipSetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByVal PixelOffsetMode As PixelOffsetMode) As Status
Private Declare Function GdipGetPixelOffsetMode Lib "gdiplus" (ByVal graphics As Long, ByRef PixelOffsetMode As PixelOffsetMode) As Status
Private Declare Function GdipSetCompositingQuality Lib "gdiplus" (ByVal graphics As Long, ByVal CompositingQuality As CompositingQualityMode) As Status
Private Declare Function GdipGetCompositingQuality Lib "gdiplus" (ByVal graphics As Long, ByRef CompositingQuality As CompositingQualityMode) As Status
Private Declare Function GdipSetCompositingMode Lib "gdiplus" (ByVal graphics As Long, ByVal CompositingMode As CompositingModeMode) As Status
Private Declare Function GdipGetCompositingMode Lib "gdiplus" (ByVal graphics As Long, ByRef CompositingMode As CompositingModeMode) As Status

' ----==== Variablen ====----
Dim GdipToken As Long
Dim GdipInitialized As Boolean

'------------------------------------------------------
' Funktion     : StartUpGDIPlus
' Beschreibung : Initialisiert GDI+ Instanz
' Übergabewert : GDI+ Version
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Status
    ' Initialisieren der GDI+ Instanz
    Dim GdipStartupInput As GDIPlusStartupInput
    GdipStartupInput.GdiPlusVersion = GdipVersion
    StartUpGDIPlus = GdiplusStartup(GdipToken, GdipStartupInput, ByVal 0)
End Function

'------------------------------------------------------
' Funktion     : ShutdownGDIPlus
' Beschreibung : Beendet die GDI+ Instanz
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function ShutdownGDIPlus() As Status
    ' Beendet GDI+ Instanz
    ShutdownGDIPlus = GdiplusShutdown(GdipToken)
End Function

'------------------------------------------------------
' Funktion     : Execute
' Beschreibung : Gibt im Fehlerfall die entsprechende GDI+ Fehlermeldung aus
' Übergabewert : GDI+ Status
' Rückgabewert : GDI+ Status
'------------------------------------------------------
Private Function Execute(ByVal lReturn As Status) As Status
    Dim lCurErr As Status
    If lReturn = Status.OK Then
        lCurErr = Status.OK
    Else
        lCurErr = lReturn
        Call MsgBox(GdiErrorString(lReturn) & " GDI+ Error:" & lReturn, _
                     vbOKOnly, "GDI Error")
    End If
    Execute = lCurErr
End Function

'------------------------------------------------------
' Funktion     : GdiErrorString
' Beschreibung : Umwandlung der GDI+ Statuscodes in Stringcodes
' Übergabewert : GDI+ Status
' Rückgabewert : Fehlercode als String
'------------------------------------------------------
Private Function GdiErrorString(ByVal lError As Status) As String
    Dim s As String
    
    Select Case lError
    Case GenericError:              s = "Generic Error."
    Case InvalidParameter:          s = "Invalid Parameter."
    Case OutOfMemory:               s = "Out Of Memory."
    Case ObjectBusy:                s = "Object Busy."
    Case InsufficientBuffer:        s = "Insufficient Buffer."
    Case NotImplemented:            s = "Not Implemented."
    Case Win32Error:                s = "Win32 Error."
    Case WrongState:                s = "Wrong State."
    Case Aborted:                   s = "Aborted."
    Case FileNotFound:              s = "File Not Found."
    Case ValueOverflow:             s = "Value Overflow."
    Case AccessDenied:              s = "Access Denied."
    Case UnknownImageFormat:        s = "Unknown Image Format."
    Case FontFamilyNotFound:        s = "FontFamily Not Found."
    Case FontStyleNotFound:         s = "FontStyle Not Found."
    Case NotTrueTypeFont:           s = "Not TrueType Font."
    Case UnsupportedGdiplusVersion: s = "Unsupported Gdiplus Version."
    Case GdiplusNotInitialized:     s = "Gdiplus Not Initialized."
    Case PropertyNotFound:          s = "Property Not Found."
    Case PropertyNotSupported:      s = "Property Not Supported."
    Case Else:                      s = "Unknown GDI+ Error."
    End Select
    
    GdiErrorString = s
End Function

'------------------------------------------------------
' Funktion     : DrawImageFromFile
' Beschreibung : Lädt ein Bilddatei per GDI+
' Übergabewert : FileName = Pfad\Dateiname der Bilddatei
'                Percent = Größe in Prozent (100% = 1:1)
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Public Function DrawImageFromFile(ByVal FileName As String, _
    ByVal DrawHdc As Long, ByVal X As Single, ByVal Y As Single, Optional ByVal Width As Single, Optional ByVal Height As Single, _
    Optional ByVal Interpolation As InterpolationMode = InterpolationModeDefault, _
    Optional ByVal Smoothing As SmoothingMode = SmoothingModeNone, _
    Optional ByVal PixelOffset As PixelOffsetMode = PixelOffsetModeNone, _
    Optional ByVal CompositingQuality As CompositingQualityMode = CompositingQualityDefault, _
    Optional ByVal CompositingMode As CompositingModeMode = CompositingModeSourceOver) As Boolean
  
    Dim retStatus As Status
    Dim lBitmap As Long
    Dim lngGraphics As Long
    Dim ImageWidth As Single
    Dim ImageHeight As Single
    
    Call Execute(StartUpGDIPlus(GdiPlusVersion))
    ' Erzeugen eines Grafikobjekts von DrawHdc -> lngGraphics
    retStatus = Execute(GdipCreateFromHDC(DrawHdc, lngGraphics))
    If retStatus = OK Then
        
        ' Setzen der Optimierungsmodis
        'Call Execute(GdipSetSmoothingMode(lngGraphics, Smoothing))
        Call Execute(GdipSetInterpolationMode(lngGraphics, Interpolation))
        'Call Execute(GdipSetPixelOffsetMode(lngGraphics, PixelOffset))
        'Call Execute(GdipSetCompositingQuality(lngGraphics, CompositingQuality))
        'Call Execute(GdipSetCompositingMode(lngGraphics, CompositingMode))
        
        ' Öffnet die Bilddatei in lBitmap
        retStatus = Execute(GdipLoadImageFromFile(StrPtr(FileName), lBitmap))
        
        If retStatus = OK Then
              Call Execute(GdipGetImageDimension(lBitmap, ImageWidth, ImageHeight))
              Width = IIf(Width = 0, ImageWidth, Width)
              Height = IIf(Height = 0, ImageHeight, Height)
            retStatus = Execute(GdipDrawImageRect(lngGraphics, lBitmap, X, Y, Width, Height))
            ' Lösche lBitmap
            Call Execute(GdipDisposeImage(lBitmap))
            
        End If
        ' Lösche das Grafikobjekt
        Call Execute(GdipDeleteGraphics(lngGraphics))
    End If
    Call Execute(ShutdownGDIPlus)
End Function


