Icône associée

Description

Petit source bien simple pour trouver l'incon associer a un fichier

soit en sélectionnant le fichier,
soit en écrivant le par example abc.jpg sa nous donne l'icone du système pour se type de fichier

voici le code, pour le voir a l'oeuvre essayer le en le téléchargant.

Source / Exemple :


Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" ( _
          ByVal hInst As Long, _
          ByVal lpIconPath As String, _
          lpiIcon As Long) _
As Long

Private Declare Function DrawIcon Lib "user32" ( _
          ByVal hdc As Long, _
          ByVal x As Long, _
          ByVal y As Long, _
          ByVal hIcon As Long) _
As Long

Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Private Sub Command1_Click()
If Text1.Text = "" Then Exit Sub
Open App.Path & Text1 For Random As #1
Close #1
Dim mIcon As Long
mIcon = ExtractAssociatedIcon(App.hInstance, App.Path & Text1, 1)
picIcon.Cls
DrawIcon picIcon.hdc, 0, 0, mIcon
DestroyIcon mIcon
Kill App.Path & Text1
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Dir1_Click()
Dim mIcon As Long
mIcon = ExtractAssociatedIcon(App.hInstance, Dir1.Path, 1)
picIcon.Cls
DrawIcon picIcon.hdc, 0, 0, mIcon
DestroyIcon mIcon
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
Dim mIcon As Long
mIcon = ExtractAssociatedIcon(App.hInstance, File1.Path & "\" & File1.FileName, Text2)
picIcon.Cls
DrawIcon picIcon.hdc, 0, 0, mIcon
DestroyIcon mIcon
End Sub

Conclusion :


Amuser vous bien

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.