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