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
Anzeige
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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
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. |