Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0732: Bilder mit GDI+ zeichnen

VB 5/6-Tipp 0732: Bilder mit GDI+ zeichnen

 von Philipp Stephani

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GdipCreateFromHDC, GdipDeleteGraphics, GdipDisposeImage, GdipDrawImageRect, GdipGetImageDimension, GdipGraphicsClear, GdipLoadImageFromFile, GdiplusShutdown, GdiplusStartup

Download: Download des Beispielprojektes [2,77 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 prjBildMitGDIPlus.vbp  --------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (comdlg32.ocx)' wird benötigt.

'--- Anfang Formular "frmBildMitGDIPlus" alias frmBildMitGDIPlus.frm  ---
' Steuerelement: Schaltfläche "cmdLaden"
' Steuerelement: Standarddialog-Steuerelement "cdlDatei"
Option Explicit

' Global:
Private Declare Function GdiplusStartup Lib "gdiplus.dll" ( _
                         ByRef token As Long, _
                         ByRef inputX As GdiplusStartupInput, _
                         ByVal Output As Long) As Status
                         
Private Declare Sub GdiplusShutdown Lib "gdiplus.dll" ( _
                         ByVal token As Long)
                    
' Graphics:
Private Declare Function GdipCreateFromHDC Lib "gdiplus.dll" ( _
                         ByVal hdc As Long, _
                         ByRef graphics As Long) As Status
                         
Private Declare Function GdipDeleteGraphics Lib "gdiplus.dll" ( _
                         ByVal graphics As Long) As Status
                         
Private Declare Function GdipGraphicsClear Lib "gdiplus.dll" ( _
                         ByVal graphics As Long, _
                         ByVal color As Long) As Status
                         
Private Declare Function GdipDrawImageRect Lib "gdiplus.dll" ( _
                         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
                         
' Image:
Private Declare Function GdipLoadImageFromFile Lib "gdiplus.dll" ( _
                         ByVal FileName As Long, _
                         ByRef image As Long) As Status
                         
Private Declare Function GdipDisposeImage Lib "gdiplus.dll" ( _
                         ByVal image As Long) As Status
                         
Private Declare Function GdipGetImageDimension Lib "gdiplus.dll" ( _
                         ByVal image As Long, _
                         ByRef Width As Single, _
                         ByRef Height As Single) As Status
                         
Private Enum 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 Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private mInstance As Long
Private mGraphics As Long

Private Sub cmdLaden_Click()
    Dim Pointer As Long
    Dim Width As Single
    Dim Height As Single
    
    With Me.cdlDatei
        .ShowOpen
        
        If Len(.FileName) Then
            GdipLoadImageFromFile StrPtr(.FileName), Pointer
            GdipGetImageDimension Pointer, Width, Height
            
            GdipDrawImageRect mGraphics, Pointer, Rnd * (Me.ScaleWidth - _
                Width), Rnd * (Me.ScaleHeight - Height), Width, Height
                
            GdipDisposeImage Pointer
            Me.Refresh
        End If
    End With
End Sub

Private Sub Form_Load()
    Dim Data As GdiplusStartupInput
    
    Randomize
    Data.GdiplusVersion = 1
    
    If GdiplusStartup(mInstance, Data, 0) Then
        MsgBox "GDI+ could not be initialized", vbCritical
        Exit Sub
    End If
    
    If GdipCreateFromHDC(Me.hdc, mGraphics) Then
        MsgBox "Graphics object could not be created", vbCritical
        Exit Sub
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If mGraphics Then
        If GdipDeleteGraphics(mGraphics) Then MsgBox "Graphics object " & _
            "could not be deleted", vbCritical
    End If
    
    GdiplusShutdown mInstance
End Sub

'--- Ende Formular "frmBildMitGDIPlus" alias frmBildMitGDIPlus.frm  ---
'--------- Ende Projektdatei prjBildMitGDIPlus.vbp  ---------