Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0659: Grafik mittels GDI+ drehen und spiegeln

 von 

Beschreibung 

Dieser Tipp zeigt wie man unter Verwendung von GDI+ Grafiken um feste Winkel drehen kann bzw. auch wahlweise auch an einer oder beiden Achsen spiegeln kann.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GdipCreateBitmapFromFile, GdipCreateBitmapFromHBITMAP, GdipCreateHBITMAPFromBitmap, GdipDisposeImage, GdipImageRotateFlip, GdiplusShutdown, GdiplusStartup, OleCreatePictureIndirect

Download:

Download des Beispielprojektes [4,82 KB]

'Dieser Quellcode 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!

'------ Anfang Projektdatei GDIPlusFliprotateImage.vbp ------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--- Anfang Formular "frmGDIPlusFliprotateImage" alias frmGDIPlusFliprotateImage.frm  ---
' Steuerelement: Listen-Steuerelement "List1"
' Steuerelement: Schaltfläche "cmdFlipRotate"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: Schaltfläche "cmdLoadPicture"


'------------------------------------------------------
' Benötigt : CommonDialog = CommonDialog1
'            PictureBox = Picture1
'            CommandButton = cmdLoadPicture
'            CommandButton = cmdFlipRotate
'            ListBox = List1
'------------------------------------------------------

Option Explicit

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

' ----==== Sonstige Types ====----
Private Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    hgdiObj As Long
    hPalOrXYExt As Long
End Type

Private Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7)  As Byte
End Type

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

' ----==== GDIPlus Enums ====----
Private 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

Private Enum RotateFlipType
    RotateNoneFlipNone = 0
    Rotate90FlipNone = 1
    Rotate180FlipNone = 2
    Rotate270FlipNone = 3
    RotateNoneFlipX = 4
    Rotate90FlipX = 5
    Rotate180FlipX = 6
    Rotate270FlipX = 7
    RotateNoneFlipY = Rotate180FlipX
    Rotate90FlipY = Rotate270FlipX
    Rotate180FlipY = RotateNoneFlipX
    Rotate270FlipY = Rotate90FlipX
    RotateNoneFlipXY = Rotate180FlipNone
    Rotate90FlipXY = Rotate270FlipNone
    Rotate180FlipXY = RotateNoneFlipNone
    Rotate270FlipXY = Rotate90FlipNone
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 GdipCreateBitmapFromFile Lib "gdiplus" _
    (ByVal FileName As Long, ByRef Bitmap As Long) As Status

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" _
    (ByVal Bitmap As Long, ByRef hbmReturn As Long, _
    ByVal background As Long) As Status

Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" _
    (ByVal hbm As Long, ByVal hpal As Long, ByRef Bitmap As Long) As Status

Private Declare Function GdipImageRotateFlip Lib "gdiplus" _
    (ByVal image As Long, ByVal rfType As RotateFlipType) As Status

Private Declare Function GdipDisposeImage Lib "gdiplus" _
    (ByVal image As Long) As Status

' ----==== OLE API Declarations ====----
Private Declare Sub OleCreatePictureIndirect Lib "oleaut32.dll" _
    (lpPictDesc As PICTDESC, riid As IID, ByVal fOwn As Boolean, _
    lplpvObj As Object)

' ----==== Variablen ====----
Private GdipToken As Long
Private 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     : LoadPicturePlus
' Beschreibung : Lädt ein Bilddatei per GDI+
' Übergabewert : Pfad\Dateiname der Bilddatei
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Public Function LoadPicturePlus(ByVal FileName As String) As StdPicture
    Dim retStatus As Status
    Dim lBitmap As Long
    Dim hBitmap As Long
    
    ' Öffnet die Bilddatei in lBitmap
    retStatus = Execute(GdipCreateBitmapFromFile(StrPtr(FileName), _
        lBitmap))
    
    If retStatus = OK Then
        
        ' Erzeugen einer GDI Bitmap lBitmap -> hBitmap
        retStatus = Execute(GdipCreateHBITMAPFromBitmap(lBitmap, _
            hBitmap, 0))
        
        If retStatus = OK Then
            ' Erzeugen des StdPicture Objekts von hBitmap
            Set LoadPicturePlus = HandleToPicture(hBitmap, _
                vbPicTypeBitmap)
        End If
        
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
        
    End If
End Function

'------------------------------------------------------
' Funktion     : FlipRotatePicture
' Beschreibung : Drehen von Bildern per GDI+
' Übergabewert : Pic = StdPicture
'                FlipRotate = RotateFlipType
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function FlipRotatePicture(ByVal Pic As StdPicture, _
    Optional ByVal FlipRotate As RotateFlipType = _
    RotateNoneFlipNone) As StdPicture
    
    Dim retStatus As Status
    Dim lBitmap As Long
    Dim hBitmap As Long
    
    ' Erzeuge ein GDI+ Bitmap vom Image Handle
    retStatus = Execute(GdipCreateBitmapFromHBITMAP(Pic.Handle, 0, lBitmap))
    
    If retStatus = OK Then
        
        ' FlipRotate
        retStatus = Execute(GdipImageRotateFlip(lBitmap, FlipRotate))
        
        If retStatus = OK Then
            
            ' Erzeugen der GDI bitmap
            retStatus = Execute(GdipCreateHBITMAPFromBitmap(lBitmap, _
                hBitmap, 0))
            
            If retStatus = OK Then
                ' Erzeugen des StdPicture Objekts
                Set FlipRotatePicture = HandleToPicture(hBitmap, _
                    vbPicTypeBitmap)
            End If
            
        End If
        
        ' Lösche lBitmap
        Call Execute(GdipDisposeImage(lBitmap))
        
    End If
End Function

'------------------------------------------------------
' Funktion     : HandleToPicture
' Beschreibung : Umwandeln einer GDI+ Bitmap Handle in ein StdPicture Objekt
' Übergabewert : hGDIHandle = GDI+ Bitmap Handle
'                ObjectType = Bitmaptyp
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function HandleToPicture(ByVal hGDIHandle As Long, _
ByVal ObjectType As PictureTypeConstants, _
Optional ByVal hpal As Long = 0) As StdPicture
    
    Dim tPictDesc As PICTDESC
    Dim IID_IPicture As IID
    Dim oPicture As IPicture
    
    ' Initialisiert die PICTDESC Structur
    With tPictDesc
        .cbSizeOfStruct = Len(tPictDesc)
        .picType = ObjectType
        .hgdiObj = hGDIHandle
        .hPalOrXYExt = hpal
    End With
    
    ' Initialisiert das IPicture Interface ID
    With IID_IPicture
        .Data1 = &H7BF80981
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    
    ' Erzeugen des Objekts
    OleCreatePictureIndirect tPictDesc, IID_IPicture, True, oPicture
    
    ' Rückgabe des Pictureobjekts
    Set HandleToPicture = oPicture
    
End Function

Private Sub cmdFlipRotate_Click()
    If GdipInitialized = True Then
        Dim RotateFlip As RotateFlipType
        
        Select Case List1.List(List1.ListIndex)
        Case "RotateNoneFlipNone"
            RotateFlip = RotateNoneFlipNone
        Case "Rotate90FlipNone"
            RotateFlip = Rotate90FlipNone
        Case "Rotate180FlipNone"
            RotateFlip = Rotate180FlipNone
        Case "Rotate270FlipNone"
            RotateFlip = Rotate270FlipNone
        Case "RotateNoneFlipX"
            RotateFlip = RotateNoneFlipX
        Case "Rotate90FlipX"
            RotateFlip = Rotate90FlipX
        Case "Rotate180FlipX"
            RotateFlip = Rotate180FlipX
        Case "Rotate270FlipX"
            RotateFlip = Rotate270FlipX
        Case "RotateNoneFlipY"
            RotateFlip = RotateNoneFlipY
        Case "Rotate90FlipY"
            RotateFlip = Rotate90FlipY
        Case "Rotate180FlipY"
            RotateFlip = Rotate180FlipY
        Case "Rotate270FlipY"
            RotateFlip = Rotate270FlipY
        Case "RotateNoneFlipXY"
            RotateFlip = RotateNoneFlipXY
        Case "Rotate90FlipXY"
            RotateFlip = Rotate90FlipXY
        Case "Rotate180FlipXY"
            RotateFlip = Rotate180FlipXY
        Case "Rotate270FlipXY"
            RotateFlip = Rotate270FlipXY
        End Select
        
        Picture1.Picture = FlipRotatePicture(Picture1, RotateFlip)
    End If
End Sub

Private Sub cmdLoadPicture_Click()
    On Error Goto errorhandler
    
    If GdipInitialized = True Then
        
        With CommonDialog1
           .Filter = "Images Files (*.bmp;*.gif;*.jpg;*.png;*.tif)|" & _
                     "*.bmp;*.gif;*.jpg;*.png;*.tif"
           .CancelError = True
           .ShowOpen
        End With
        
        Picture1.Picture = LoadPicturePlus(CommonDialog1.FileName)
        
        If Not Picture1.Picture Is Nothing Then cmdFlipRotate.Enabled = True
    End If
    
    Exit Sub
errorhandler:
End Sub

Private Sub Form_Load()
    Dim retStatus As Status
    GdipInitialized = False
    
    retStatus = Execute(StartUpGDIPlus(GdiPlusVersion))
    If retStatus = OK Then
        GdipInitialized = True
    Else
        MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error"
    End If
    
    cmdFlipRotate.Enabled = False
    
    List1.AddItem "RotateNoneFlipNone"
    List1.AddItem "Rotate90FlipNone"
    List1.AddItem "Rotate180FlipNone"
    List1.AddItem "Rotate270FlipNone"
    List1.AddItem "RotateNoneFlipX"
    List1.AddItem "Rotate90FlipX"
    List1.AddItem "Rotate180FlipX"
    List1.AddItem "Rotate270FlipX"
    List1.AddItem "RotateNoneFlipY"
    List1.AddItem "Rotate90FlipY"
    List1.AddItem "Rotate180FlipY"
    List1.AddItem "Rotate270FlipY"
    List1.AddItem "RotateNoneFlipXY"
    List1.AddItem "Rotate90FlipXY"
    List1.AddItem "Rotate180FlipXY"
    List1.AddItem "Rotate270FlipXY"
    List1.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim retStatus As Status

    If GdipInitialized = True Then
        retStatus = Execute(ShutdownGDIPlus)
    End If
End Sub

'--- Ende Formular "frmGDIPlusFliprotateImage" alias frmGDIPlusFliprotateImage.frm  ---
'------- Ende Projektdatei GDIPlusFliprotateImage.vbp -------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Pietro Cecchi am 30.05.2005 um 19:56

"Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?"

Ja, es funktionierte sehr gut!
Und dabei: es sheint daß es nicht die Datei schließt!!!
So, danke shön für die Kode!!!

Grüssen von Pietro

Kommentar von Pietro Cecchi am 30.05.2005 um 15:35

I hoffe this code funkzioniert...
Aber hatte eine frage betreffend: wie es moeglich ist UNLOCK eine file, nach die Call GdipLoadImageFromFile (die ungluecklich LOCKS die file)?
Ob Sie eine antwort haben, bitte wiederholen Sie mir bitte.
Danke shoen fuer Euere Freundlichkeit,
Pietro