Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0668: 24Bit- und 32Bit-Icons aus Ressource laden und anzeigen

VB 5/6-Tipp 0668: 24Bit- und 32Bit-Icons aus Ressource laden und anzeigen

 von Frank Schüler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), CreateIconFromResourceEx, OleCreatePictureIndirect

Download: Download des Beispielprojektes [69,96 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 Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

Option Explicit

' benötig eine Ressourcen-Datei (RES) mit einem Icon als
' "Custom"-Ressource ("32BitIcons") und der Ressource-ID: 101
' 24bit- und 32bit-Icons müssen als Custom-Ressource
' in der Ressourcendatei (*.RES) eingebunden werden,
' da das einbinden als normale IconRessource nicht
' funktioniert. VB selbst kann keine 32Bit Icons per
' LoadPicture-Befehl laden. Auch das setzen der
' Picture/Icon-Eigenschaft, über das Eigenschaftsfenster
' eines Controls mit einem 32bit-Icon, funktioniert nicht.

' ----==== sonstige Const ====----
Private Const IconVersion As Long = &H30000
Private Const LR_DEFAULTCOLOR As Long = &H0&

' ----==== sonstige Types ====----
Private Type IconHeader
    ihReserved As Integer
    ihType As Integer
    ihCount As Integer
End Type

Private Type IconEntry
    ieWidth As Byte
    ieHeight As Byte
    ieColorCount As Byte
    ieReserved As Byte
    iePlanes As Integer
    ieBitCount As Integer
    ieBytesInRes As Long
    ieImageOffset As Long
End Type

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

' ----==== USER32 API Declarationen ====----
Private Declare Function CreateIconFromResourceEx Lib "user32" _
    (presbits As Any, ByVal dwResSize As Long, _
    ByVal fIcon As Long, ByVal dwVer As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, _
    ByVal Flags As Long) As Long

' ----==== KERNEL32 API Declarationen ====----
Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (pDst As Any, pSrc As Any, _
    ByVal ByteLen As Long)

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

'------------------------------------------------------
' Funktion     : HandleToPicture
' Beschreibung : Umwandeln eines Bitmaphandle
'                in ein StdPicture Objekt
' Übergabewert : hBMPHandle = Bitmaphandle
'                ObjectType = Bitmaptyp
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function HandleToPicture(ByVal hBMPHandle As Long, _
    ByVal ObjectType As PictureTypeConstants, _
    Optional ByVal hpal As Long = 0) As StdPicture
    
    On Error Goto PROC_ERR
    
    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 = hBMPHandle
        .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
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "HandleToPicture"
    Resume PROC_EXIT
    
End Function

'------------------------------------------------------
' Funktion     : LoadIconFromRes
' Beschreibung : Laden von 24bit- und 32bit Icons
'                aus einer "Custom"-Resource
' Übergabewert : ResIndex = Kennung (ID) der Daten
'                           in der Ressourcedatei
'                ResFormat = Zeichenfolgenname der
'                            benutzerdefinierten Ressource
'                IconIndex = Index des zuladenden Icons
' Rückgabewert : StdPicture Objekt
'------------------------------------------------------
Private Function LoadIconFromRes(ByVal ResIndex As Long, _
    ByVal ResFormat As String, _
    ByVal IconIndex As Long) As StdPicture
    
    On Error Goto PROC_ERR
    
    Dim hIcon As Long
    Dim ResData() As Byte
    Dim tIconHeader As IconHeader
    Dim tIconEntry() As IconEntry
    
    ' Resource in ByteArray speichern
    ResData = LoadResData(ResIndex, ResFormat)
    
    ' IconHeader aus ByteArray kopieren
    Call CopyMemory(tIconHeader, ResData(0), LenB(tIconHeader))
    
    ' ist das eine Icondatei
    ' ihType muss 1 sein
    If tIconHeader.ihType = 1 Then
        
        'ihCount enthält die Anzahl der Icons
        
        ' gibt es diesen IconIndex
        If IconIndex >= 0 Then
            If IconIndex <= tIconHeader.ihCount - 1 Then
                
                ' IconEntry dimensionieren
                ReDim tIconEntry(tIconHeader.ihCount - 1)
                
                ' IconEntry´s aus ByteArray kopieren
                Call CopyMemory(tIconEntry(0), _
                ResData(LenB(tIconHeader)), _
                LenB(tIconEntry(0)) * tIconHeader.ihCount)
                
                ' tIconEntry enthält nun alle wichtigen
                ' Daten wie Größe der Icons, Bittiefe der
                ' Icons, Start und Größe in Byte der
                ' einzelnen Icons
                
                ' Icon aus Resource erzeugen bzw.
                ' Handle vom Icon ermitteln
                hIcon = CreateIconFromResourceEx( _
                ResData(tIconEntry(IconIndex).ieImageOffset), _
                tIconEntry(IconIndex).ieBytesInRes, 1, IconVersion, _
                tIconEntry(IconIndex).ieWidth, _
                tIconEntry(IconIndex).ieHeight, LR_DEFAULTCOLOR)
                
                ' StdPicture Objekt erstellen (Icon)
                Set LoadIconFromRes = HandleToPicture(hIcon, _
                vbPicTypeIcon)
                
            End If
        End If
    End If
    
PROC_EXIT:
    Exit Function
    
PROC_ERR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "LoadIconFromRes"
    Resume PROC_EXIT
    
End Function

Private Sub Form_Load()
    ' Lädt das 3. Icon aus der "32BitIcons"-Resource
    ' mit der ID "101"
    Me.Icon = LoadIconFromRes(101, "32BitIcons", 2)
    
    ' Lädt das 8. Icon aus der "32BitIcons"-Resource
    ' mit der ID "101"
    Me.Picture = LoadIconFromRes(101, "32BitIcons", 7)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

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