VB 5/6-Tipp 0661: Grafik mittels GDI+ um freien Winkel drehen
von Frank Schüler
Beschreibung
Dieser Tipp zeigt wie man unter Verwendung von GDI+ Grafiken um einen frei wählbaren Winkel drehen kann.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: GdipCreateBitmapFromHBITMAP, GdipCreateFromHDC, GdipDeleteGraphics, GdipDisposeImage, GdipDrawImageRect, GdipGetImageDimension, GdipResetWorldTransform, GdipRotateWorldTransform, GdipTranslateWorldTransform, GdiplusShutdown, GdiplusStartup | Download: |
'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 GDIPlusRotateAngleImage.vbp ----- '--- Anfang Formular "frmGDIPlusRotateAngleImage" alias frmGDIPlusRotateAngleImage.frm --- ' Steuerelement: Bildfeld-Steuerelement "Picture1" Option Explicit ' ----==== GDIPlus Const ====---- Private Const GdiPlusVersion As Long = 1 ' ----==== 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 MatrixOrder MatrixOrderPrepend = 0 MatrixOrderAppend = 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 GdipGetImageDimension Lib "gdiplus" _ (ByVal image As Long, ByRef Width As Single, _ ByRef Height As Single) As Status Private Declare Function GdipRotateWorldTransform Lib "gdiplus" _ (ByVal graphics As Long, ByVal angle As Single, _ ByVal order As MatrixOrder) As Status Private Declare Function GdipTranslateWorldTransform Lib "gdiplus" _ (ByVal graphics As Long, ByVal dx As Single, ByVal dy As Single, _ ByVal order As MatrixOrder) As Status Private Declare Function GdipResetWorldTransform 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 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 GdipCreateBitmapFromHBITMAP Lib "gdiplus" _ (ByVal hbm As Long, ByVal hpal As Long, _ ByRef Bitmap As Long) As Status Private Declare Function GdipDisposeImage Lib "gdiplus" _ (ByVal image As Long) As Status ' ----==== 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 NotTrueTypeFont: s = "Not TrueType Font." 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 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 End Sub Private Sub Form_Unload(Cancel As Integer) Dim retStatus As Status If GdipInitialized = True Then retStatus = Execute(ShutdownGDIPlus) End If End Sub Private Sub Picture1_Click() Dim retStatus As Long Dim lBitmap As Long Dim lngGraphics As Long Dim sngWidth As Single Dim sngHeight As Single Dim sngAngle As Single Static running As Boolean If running Then Exit Sub running = True If GdipInitialized = True Then retStatus = Execute(GdipCreateFromHDC(Picture1.hdc, lngGraphics)) If retStatus = OK Then retStatus = Execute(GdipCreateBitmapFromHBITMAP( _ Picture1.Picture.Handle, 0, lBitmap)) If retStatus = OK Then Call Execute(GdipGetImageDimension(lBitmap, sngWidth, _ sngHeight)) For sngAngle = 180 To 540 Call Execute(GdipRotateWorldTransform(lngGraphics, _ sngAngle, MatrixOrderPrepend)) Call Execute(GdipTranslateWorldTransform(lngGraphics, _ sngWidth \ 2, sngHeight \ 2, MatrixOrderAppend)) Call Execute(GdipDrawImageRect(lngGraphics, lBitmap, _ sngWidth \ 2, sngHeight \ 2, -sngWidth, -sngHeight)) Call Execute(GdipResetWorldTransform(lngGraphics)) DoEvents Next sngAngle ' Destroy the bitmap Call Execute(GdipDisposeImage(lBitmap)) End If Call Execute(GdipDeleteGraphics(lngGraphics)) End If End If running = False End Sub '--- Ende Formular "frmGDIPlusRotateAngleImage" alias frmGDIPlusRotateAngleImage.frm --- '------ Ende Projektdatei GDIPlusRotateAngleImage.vbp ------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB5 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB6 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
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 Paul am 26.04.2005 um 12:28
Ein doppeltes "Case else" in "Function GdiErrorString"
Paul
Kommentar von Paul am 26.04.2005 um 12:23
Prima Sache !!!
Unter Win98 treten allerdings GDI-Errors mit diversen Fehlercodes auf die alle mit -2122 beginnen :
-2122775680
-2122908220
-2122910172
-2122757704
u.a.
Das Drehen funktioniert aber denoch !!!
Was sind das für Fehlercodes bzw. wie man die Fehlermeldung unterdrücken da es immer andere Codes sind ?
Gruß
Paul