vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Grafik und Font · Bilder & Icons   |   VB-Versionen: VB5, VB616.04.08
Icon in Bitmap konvertieren

Mit dieser Funktion lässt sich ein Icon in ein Bitmap umwandeln und als StdPicture-Objekt innerhalb der Anwendung verwenden.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  14.485 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Hin und wieder kommt es vor, dass man ein Icon (.ICO-Datei) in ein Bitmap umwandeln muss. Ein Beispiel hierfür ist das Kopieren einer Symboldatei in die Windows-Zwischenablage, um dieses in anderen Anwendungen weiterverarbeiten zu können. Wenn Sie eine Symboldatei (Icon) laden und versuchen in die Zwischenablage zu kopieren, quittiert Ihnen VB das mit einer Fehlermeldung, dass es sich um ein falsches Clipboard-Format handelt. Bitmaps hingegen lassen sich ohne Probleme via Clipboard.SetData in die Zwischenablage kopieren.

Mit der Funktion IconToBitmap ist es möglich ein Icon in ein Bitmap umzuwandeln und dieses als StdPicture-Objekt weiterzuverwenden, wobei optional sogar noch die gewünschte Hintergrundfarbe angegeben werden kann.

Fügen Sie den nachfolgenden Code in ein Modul:

Option Explicit
 
' benötigte API-Deklarationen
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long
 
Private Declare Function GetDC Lib "user32.dll" ( _
  ByVal hWnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32.dll" ( _
  ByVal hWnd As Long, _
  ByVal hDC As Long) As Long
 
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" ( _
  ByVal hDC As Long, _
  ByVal nWidth As Long, _
  ByVal nHeight As Long) As Long
 
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" ( _
  ByVal hDC As Long) As Long
 
Private Declare Function DeleteDC Lib "gdi32.dll" ( _
  ByVal hDC As Long) As Long
 
Private Declare Function SelectObject Lib "gdi32.dll" ( _
  ByVal hDC As Long, _
  ByVal hObject As Long) As Long
 
Private Declare Function DrawIconEx Lib "user32.dll" ( _
  ByVal hDC As Long, _
  ByVal xLeft As Long, _
  ByVal yTop As Long, _
  ByVal hIcon As Long, _
  ByVal cxWidth As Long, _
  ByVal cyWidth As Long, _
  ByVal istepIfAniCur As Long, _
  ByVal hbrFlickerFreeDraw As Long, _
  ByVal diFlags As Long) As Long
 
Private Declare Function CreateSolidBrush Lib "gdi32.dll" ( _
  ByVal crColor As Long) As Long
 
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
  lpPictDesc As PictDesc, _
  riid As Any, _
  ByVal fOwn As Long, _
  lplpvObj As IPicture) As Long
 
Private Declare Function GetSysColor Lib "user32.dll" ( _
  ByVal nIndex As Long) As Long
 
Private Const DI_NORMAL = &H3
 
Private Type PictDesc
  cbSizeofStruct As Long
  picType As Long
  hImage As Long
  xExt As Long
  yExt As Long
End Type
' Wandelt ein Icon in ein Bitmap um und gibt dieses
' als StdPicture-Objekt zurück
Public Function IconToBitmap(oIcon As StdPicture, _
  Optional ByVal BackColor As Long = vbButtonFace, _
  Optional ByVal nWidth As Long = 32, _
  Optional ByVal nHeight As Long = 32)
 
  Dim DeskDC As Long
  Dim hDC As Long
  Dim hBmp As Long
  Dim hBmpOld As Long
  Dim hBrush As Long
  Dim IID_IPicture(3) As Long
  Dim PD As PictDesc
  Dim NewPic As StdPicture
 
  ' Device-Context erstellen
  DeskDC = GetDC(GetDesktopWindow)
  hDC = CreateCompatibleDC(DeskDC)
  If hDC <> 0 Then
    ' Compatibles Bitmap in erforderlicher Größe erzeugen
    hBmp = CreateCompatibleBitmap(DeskDC, nWidth, nHeight)
    hBmpOld = SelectObject(hDC, hBmp)
 
    ' gewünschte Hintergrundfarbe
    If (BackColor And &HFF000000) = &H80000000 Then _
      BackColor = GetSysColor(BackColor And &HFFFFFF)
    hBrush = CreateSolidBrush(BackColor)
 
    ' Icon in den Device-Context zeichnen
    DrawIconEx hDC, 0, 0, oIcon.handle, nWidth, nHeight, 0, hBrush, DI_NORMAL
 
    ' Handles wieder auflösen
    SelectObject hDC, hBmpOld
    DeleteDC hDC
 
    ' jetzt aus dem Bitmap-Handle ein
    ' StdPicture-Objekt erzeugen
    IID_IPicture(0) = &H7BF80980
    IID_IPicture(1) = &H101ABF32
    IID_IPicture(2) = &HAA00BB8B
    IID_IPicture(3) = &HAB0C3000
 
    With PD
      .cbSizeofStruct = Len(PD)
      .hImage = hBmp
      .picType = vbPicTypeBitmap
    End With
    OleCreatePictureIndirect PD, IID_IPicture(0), 1, NewPic
 
    ' StdPicture (Bitmap) zurückgeben
    Set IconToBitmap = NewPic
  Else
    Set IconToBitmap = Nothing
  End If
 
  ' Device-Context wieder freigeben
  ReleaseDC GetDesktopWindow, DeskDC
End Function

Beispiel für den Aufruf:

' Icon aus Datei laden und als Bitmap in die Zwischenablage kopieren
Dim oIcon As StdPicture
Set oIcon = LoadPicture(App.Path & "\MyIcon.ico")
 
' Icon in Bitmap umwandeln
Dim oBitmap As StdPicture
oBitmap = IconToBitmap(oIcon, vbWhite, 32, 32)

Weiteres Beispiel:

' Icons aus Datei laden und als Bitmap speichern
Dim oIcon As StdPicture
Set oIcon = LoadPicture(App.Path & "\MyIcon.ico")
 
' in Bitmap umwandeln und speichern
SavePicture IconToBitmap(oIcon, , 32, 32), App.Path & "\MyBitmap.bmp"

Dieser Tipp wurde bereits 14.485 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (6 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel