Rubrik: Grafik und Font · Bilder & Icons | VB-Versionen: VB5, VB6 | 16.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 Otter | Bewertung: | Views: 14.484 |
www.tools4vb.de | System: 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"