Die Community zu .NET und Classic VB.

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

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

 von Philipp Stephani

Schwierigkeitsgrad:

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

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

'--- Anfang Formular "frmBildMitGDIPlus" alias frmBildMitGDIPlus.frm  ---
' Steuerelement: Standarddialog-Steuerelement "cdlDatei"
' Steuerelement: Schaltfläche "cmdLaden"
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 GdipDrawImage Lib "gdiplus.dll" ( _
    ByVal graphics As Long, ByVal Image As Long, _
    ByVal X As Single, ByVal Y 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 m_lngInstance As Long
Private m_lngGraphics As Long

Private Sub cmdLaden_Click()
    Dim lngPointer As Long
    Dim sngWidth As Single
    Dim sngHeight As Single

    With Me.cdlDatei
        .ShowOpen
        If Len(.FileName) Then
            GdipLoadImageFromFile StrPtr(.FileName), lngPointer
            GdipGetImageDimension lngPointer, sngWidth, sngHeight
            
            GdipDrawImage m_lngGraphics, lngPointer, _
                Rnd * (Me.ScaleWidth - sngWidth), Rnd * (Me.ScaleHeight - sngHeight)
            
            GdipDisposeImage lngPointer
            Me.Refresh
        End If
    End With
End Sub

Private Sub Form_Load()
    Dim udtData As GdiplusStartupInput
    
    Randomize
    
    udtData.GdiplusVersion = 1

    If GdiplusStartup(m_lngInstance, udtData, 0) Then
        MsgBox "GDI+ could not be initialized", vbCritical
        Exit Sub
    End If
    
    If GdipCreateFromHDC(Me.hdc, m_lngGraphics) Then
        MsgBox "Graphics object could not be created", vbCritical
        Exit Sub
    End If
End Sub

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

    GdiplusShutdown m_lngInstance
End Sub
'--- Ende Formular "frmBildMitGDIPlus" alias frmBildMitGDIPlus.frm  ---
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 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.