Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0569: Icon aus Ressourcendatei laden

VB 5/6-Tipp 0569: Icon aus Ressourcendatei laden

 von Herfried K. Wagner

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), FreeLibrary, LoadIconA (LoadIcon), LoadLibraryA (LoadLibrary), OleCreatePictureIndirect

Download: Download des Beispielprojektes [3,23 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 LoadIconFromLibrary.vbp  -------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (mscomctl.ocx)' wird benötigt.

'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Bilderlistenelement "ilsIcons"
' Steuerelement: Listenanzeigesteuerungselement "lvSample"

' Autor:  Herfried Karl Wagner <Hirf@ActiveVB.de>

' Hinweis: Hier wird LoadIcon demonstriert. Das selbe geht natürlich auch mit
'          LoadCursor und LoadImage

Option Explicit

Private Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" _
    (ByVal hInstance As Long, ByVal lpIconName As String) As Long
    
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
    (ByVal lpLibFileName As String) As Long
    
Private Declare Function FreeLibrary Lib "kernel32.dll" _
    (ByVal hLibModule As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
    (ByRef lpDest As Any, ByRef lpSource As Any, ByVal nCount As Long)

Private Const ERROR_SUCCESS As Long = 0&

Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

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

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
    (ByRef lpPictDesc As PictDesc, ByRef riid As Guid, _
    ByVal fPictureOwnsHandle As Long, ByRef ipic As IPicture) As Long

Private Sub Form_Load()
    Dim strFilename As String
    ' Dateiname der DLL (Kann z.B: eine in C geschrieben Ressourcendatei sein)
    strFilename = "SHELL32.DLL"
    'strFilename = "C:\WINDOWS\SYSTEM\SHELL32.DLL"
    'strFilename = "C:\WINDOWS\SYSTEM32\SHELL32.DLL"
    Dim h As Long
    h = LoadLibrary(strFilename)
    If h = ERROR_SUCCESS Then
        MsgBox "DLL """ & strFilename & """ konnte nicht geladen werden!", _
            vbExclamation, App.Title
    Else
        Dim hIcon As Long
        Dim lngIconNumber As Long
        ' Die Icon nummer in der Ressource
        lngIconNumber = 1
        hIcon = LoadIcon(h, MAKEINTRESOURCE(lngIconNumber))
        If hIcon = ERROR_SUCCESS Then
             MsgBox "Fehler beim Laden des Icons mit Nummer " & _
                    CStr(lngIconNumber) & " aus """ & strFilename & """!", _
                    vbExclamation, App.Title
        Else
            ' Icon Anzeigen
            Call ilsIcons.ListImages.Add(1, "ICON_" & lngIconNumber, IconToPicture(hIcon))
            Set lvSample.Icons = ilsIcons
            Call lvSample.ListItems.Add(1, "ITEM_" & lngIconNumber, "Icon " & lngIconNumber, 1)
        End If
        Call FreeLibrary(h)
    End If
End Sub

Public Function IconToPicture(ByVal hIcon As Long) As IPicture
    ' Icon in Picture umwandeln
    If hIcon = 0 Then
        Exit Function
    End If
    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid
    With tPicConv
        .cbSizeofStruct = Len(tPicConv)
        .picType = vbPicTypeIcon
        .hImage = hIcon
    End With
    
    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}.
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    Call OleCreatePictureIndirect(tPicConv, IGuid, True, oNewPic)
    Set IconToPicture = oNewPic
End Function

Public Function MAKEINTRESOURCE(ByVal lID As Long) As String
    MAKEINTRESOURCE = "#" & CStr(MAKELONG(lID, 0))
End Function

Public Function LOWORD(ByVal dwValue As Long) As Long
    Call CopyMemory(LOWORD, dwValue, 2)
End Function

Public Function MAKELONG(ByVal wLow As Long, ByVal wHi As Long) As Long
    If (wHi And &H8000&) Then
        MAKELONG = (((wHi And &H7FFF&) * 65536) Or (wLow And &HFFFF&)) Or &H80000000
    Else
        MAKELONG = LOWORD(wLow) Or (&H10000 * LOWORD(wHi))
    End If
End Function
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'-------- Ende Projektdatei LoadIconFromLibrary.vbp  --------

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.