ICÔNE ASSOCIÉE

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
 

Télécharger le zip