vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik:    |   VB-Versionen: VB5, VB601.10.04
Windows-Symbol einer Datei/einer Verknüpfung ermitteln

Diesmal zeigen wir eine Möglichkeit, wie sich das Windows-Symbol (Icon) einer Anwendung oder eines Dokuments ermitteln lässt, und zwar so, wie es auch im Windows-Explorer angezeigt wird.

Autor:  Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.518 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt 

Diesmal zeigen wir eine Möglichkeit, wie sich das Windows-Symbol (Icon) einer Anwendung oder eines Dokuments ermitteln lässt, und zwar so, wie es auch im Windows-Explorer angezeigt wird. Hierbei lässt sich entweder das kleine oder das große Symbol ermitteln. Weiterhin wird das Symbol mit der Farbtiefe ausgelesen, wie es auch im Explorer dargestellt wird, also nicht unbedingt in 16 Farben, sondern bspw. in 256 Farben.

Fügen Sie zunächst nachfolgenden Code in ein Modul:

Option Explicit
 
' Benötigte API-Deklarationen
Private Const MAX_PATH As Long = 260
 
Private Type SHFILEINFO
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
 
Private Declare Function SHGetFileInfo Lib "shell32.dll" _
  Alias "SHGetFileInfoA" ( _
  ByVal pszPath As String, _
  ByVal dwFileAttributes As Long, _
  ByRef psfi As SHFILEINFO, _
  ByVal cbFileInfo As Long, _
  ByVal uFlags As Long) As Long
 
Private Type tGUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
 
Private Type PictDesc
  cbSizeofStruct As Long
  picType As Long
  hImage As Long
  xExt As Long
  yExt As Long
End Type
 
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
  ByRef lpPictDesc As PictDesc, _
  ByRef riid As tGUID, _
  ByVal fOwn As Long, _
  ByRef lplpvObj As IPicture) As Long
 
Public Enum FileIconSize
  IconSmall = &H101
  IconLarge = &H100
End Enum
' Icon einer Datei ermitteln
Public Function GetFileIcon(ByVal sFile As String, _
  Optional ByVal nSize As FileIconSize = IconSmall) As Picture
 
  Dim tPic As PictDesc
  Dim tGUID As tGUID
  Dim tInfo As SHFILEINFO
  Dim oPic As Picture
  Dim nResult As Long
 
  ' File-Informationen lesen
  Call SHGetFileInfo(sFile, 2, tInfo, Len(tInfo), nSize)
 
  ' Standard-Picture erstellen
  With tPic
    .cbSizeofStruct = Len(tPic)
    .picType = vbPicTypeIcon
    .hImage = tInfo.hIcon    
  End With
 
  tGUID.Data1 = &H20400
  tGUID.Data4(0) = &HC0
  tGUID.Data4(7) = &H46   
 
  nResult = OleCreatePictureIndirect(tPic, tGUID, 1, oPic)
 
  ' Picture zurückgeben
  Set GetFileIcon = oPic
End Function

Anwendungsbeispiel:

' Symbol des Windows-Editors ermitteln und in 
' einem Image-Control anzeigen
Image1.Picture = GetFileIcon("c:\windows\notepad.exe", IconSmall)

Jetzt kann es allerdings vorkommen, dass das Icon einen schwarzen Rand hat bzw. die transparenten Bereiche des Icons schwarz dargestellt werden. Mit Hilfe des ImageList-Controls lässt sich dieses Problem allerdings wie folgt beheben: Zunächst wird das Bildsymbol der ImageList hinzugefügt. Über die ExtractIcon-Methode wird das Bild dann mit den korrekten (transparenten) Farben extrahiert:

' Symbol des Windows-Editors ermitteln und zunächst 
' dem ImageList-Control hinzufügen
ImageList1.ListImages.Add , , GetFileIcon("c:\windows\notepad.exe", IconSmall)
 
' ExtractIcon-Methode aufrufen und das Icon dann dem Image-Control zuweisen
Image1.Picture = ImageList1.ListImages(1).ExtractIcon

Möchten Sie die Bildsymbole generell im ImageList-Control ablegen, gehen Sie wie folgt vor:

With ImageList1.ListImages
  ' Symbol des Windows-Editors ermitteln und dem 
  ' ImageList-Control hinzufügen
  .Add , , GetFileIcon("c:\windows\notepad.exe", IconSmall)
 
  ' Symbol innerhalb der ImageList durch ExtractIcon-Bild ersetzen
  ' und ursprüngliches Bild löschen
  .Add , , .Item(.Count).ExtractIcon
  .Remove .Count - 1
End With