Commit | Line | Data |
0d212c7b |
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 |
62046253 |
41 | SendMessageA hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon |
0d212c7b |
42 | End Sub |