FixIcon.bas

   1 Attribute VB_Name = "FixWindowIcon"
   2 Option Explicit
   3
   4 Private Const WM_SETICON = &H80
   5 Private Const ICON_SMALL = 0
   6 Private Const IMAGE_ICON = 1
   7 Private Const LR_DEFAULTSIZE = &H40
   8
   9 Private Declare Function GetModuleHandle Lib "Kernel32.dll" _
  10     Alias "GetModuleHandleA" _
  11     (ByRef lpModuleName As Any) As Long
  12 Private Declare Function LoadImage Lib "User32.dll" _
  13     Alias "LoadImageA" ( _
  14     ByVal hinst As Long, _
  15     ByRef lpszName As Any, _
  16     ByVal uType As Long, _
  17     ByVal cxDesired As Long, _
  18     ByVal cyDesired As Long, _
  19     ByVal fuLoad As Long) As Long
  20 Private Declare Function SendMessageA Lib _
  21     "User32.dll" _
  22     (ByVal hWnd As Long, _
  23     ByVal Msg As Long, _
  24     ByVal Wp As Long, _
  25     Lp As Any) As Long
  26
  27 Sub FixIcon(hWnd As Long, lpszName)
  28 Dim hModule As Long, hIcon As Long, szName As String, nName As Long, Width As Long, Height As Long
  29 hModule = GetModuleHandle(ByVal 0&)
  30 If hModule = 0 Then Exit Sub
  31 Width = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionWidth", -270)) / Screen.TwipsPerPixelX - 2
  32 Height = Abs(GetReg("HKEY_USERS\.Default\Control Panel\Desktop\WindowMetrics\CaptionHeight", -270)) / Screen.TwipsPerPixelY - 2
  33 If VarType(lpszName) = vbString Then
  34     szName = lpszName
  35     hIcon = LoadImage(hModule, szName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
  36 ElseIf VarType(lpszName) = vbByte Or VarType(lpszName) = vbInteger Or VarType(lpszName) = vbLong Then
  37     nName = lpszName
  38     hIcon = LoadImage(hModule, ByVal nName, IMAGE_ICON, Width, Height, LR_DEFAULTSIZE)
  39 End If
  40 If hIcon = 0 Then Exit Sub
  41 SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon
  42 End Sub