Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Public Declare Function ExtractIconEx Lib "shell32.dll" _
Alias "ExtractIconExA" (ByVal lpszFile As String, _
ByVal nIconIndex As Long, phiconLarge As Long, _
phiconSmall As Long, ByVal nIcons As Long) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Public Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon As Long) As Long
'________________________________
Sub sAddIconToImageList(ByVal strExe As String, _
ByVal intFallBackID As Integer)
'--- Given the name of an exe or dll file,
' extracts the first small icon
' and loads it in the image list bound to the
' treeview and listview controls
'--- Parameters
' [In]
' strExe: full path & filename of exe or dll
' containing the icon resource
' intFallBackID: id of icon in res file to use
' if no icons found in the exe
Dim objImg As ListImage 'New list image object
Dim lngRtn As Long 'API function return value
Dim ahLIcon(1 To 1) As Long 'Array to receive large icon handles
Dim ahSIcon(1 To 1) As Long 'Array to receive small icon handles
'Just in case we get an 'invalid picture' error at run-time
On Error GoTo LocalErr
'Extract the first icon and small icon from the file
lngRtn = ExtractIconEx(strExe, CLng(0), ahLIcon(1), ahSIcon(1), 1)
'Clear the picture box
Set picIcon.Picture = LoadPicture("")
picIcon.AutoRedraw = True
Reenter:
If ahSIcon(1) = 0 Then
'No icon, load a fall back
Set picIcon.Picture = LoadResPicture(intFallBackID, vbResIcon)
Else
'Draw the icon in the picture box
lngRtn = DrawIcon(picIcon.hdc, 0, 0, ahSIcon(1))
'Assign the drawn image to the picture property
picIcon.Picture = picIcon.Image
End If
picIcon.AutoRedraw = False
picIcon.Refresh
'Add the icon to the image list from the picture control
Set objImg = imgIcon.ListImages.Add _
(, strExe & CStr(mintImgCount), picIcon.Picture)
'Increment the module level counter
mintImgCount = mintImgCount + 1
GoTo ExitSub
LocalErr:
If Err.Number = 481 Then
'Invalid picture, load the fallback icon
ahSIcon(1) = 0
Resume Reenter
Else
'Tidy up
DestroyIcon ahLIcon(1)
DestroyIcon ahSIcon(1)
Set objImg = Nothing
'Turn off local handler
On Error GoTo 0
'Pass the error up the call stack
Err.Raise Err.Number, Err.Description
End If
ExitSub:
DestroyIcon ahLIcon(1)
DestroyIcon ahSIcon(1)
Set objImg = Nothing
End Sub